[rfc] rewrite of local equivalences

[Richard Henderson <rth at twiddle dot net>]

While staring at output for the nearest intrinsic test case, I
noticed how ugly the generated code for equivalences is.  And 
that the existing implementation can in fact fail to provide
sufficient alignment for the types involved.

My replacement implementation uses a UNION_TYPE, with the caveat
that offsets of the fields are not necessarily zero.  (Jason, do
you think this will cause problems?  It doesn't seem to...)  We
then treat the members of the equivalence more or less like 
members of a C++ anonymous union.

I'm somewhat concerned that there are almost no test cases for
equivalence in the test suite, so I have no idea what happens
here for corner cases.

This is not a complete patch.  I have Hordes of other things in
my tree at present, and I didn't want to confuse the issue, or
figure out what bits this actually relies on.  It may be only
exporting update_alignment_for_field from stor-layout.c.

Thoughts?


r~




Index: trans-decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/trans-decl.c,v
retrieving revision 1.1.2.21
diff -u -p -c -r1.1.2.21 trans-decl.c
*** trans-decl.c	27 Nov 2003 00:26:19 -0000	1.1.2.21
--- trans-decl.c	27 Nov 2003 04:19:24 -0000
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 697,723 ****
  
    if (sym->addr_base)
      {
!       /* For COMMON variables or local EQUIVALENCE objects we
!          access then through the composite object.
!          *(type_t *)&block[offset] */
! 
!       decl = build (ARRAY_REF, TREE_TYPE (TREE_TYPE (sym->addr_base)),
!                     sym->addr_base, sym->addr_offset);
!       decl = build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (decl)),
!                      decl);
  
!       decl = convert(build_pointer_type (gfc_sym_type (sym)), decl);
!       decl = build1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (decl)), decl);
  
- #if 0
        /* TODO: output symbols in COMMON for debugging information.  */
-       rtx base = DECL_RTL (sym->addr_base);
-       HOST_WIDE_INT offset = TREE_INT_CST_LOW (sym->addr_offset);
  
-       SET_DECL_RTL (decl,
-                     gen_rtx_MEM (DECL_MODE (decl),
-                                  plus_constant (XEXP (base, 0), offset)));
- #endif
        if (sym->ts.type == BT_CHARACTER)
          {
            assert (sym->ts.cl->length->expr_type == EXPR_CONSTANT);
--- 697,720 ----
  
    if (sym->addr_base)
      {
!       /* For local EQUIVALENCE objects we've already built the reference.  */
!       if (!sym->addr_offset)
! 	decl = sym->addr_base;
  
!       /* For COMMON variables we access then through the composite object.
!          *(type_t *)&block[offset] */
!       else
! 	{
! 	  decl = build (ARRAY_REF, TREE_TYPE (TREE_TYPE (sym->addr_base)),
! 			sym->addr_base, sym->addr_offset);
! 	  decl = build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (decl)),
! 			 decl);
! 	  decl = convert(build_pointer_type (gfc_sym_type (sym)), decl);
! 	  decl = build1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (decl)), decl);
! 	}
  
        /* TODO: output symbols in COMMON for debugging information.  */
  
        if (sym->ts.type == BT_CHARACTER)
          {
            assert (sym->ts.cl->length->expr_type == EXPR_CONSTANT);
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 730,735 ****
--- 727,733 ----
               are part of a common block.  */
            gfc_todo_error ("CHARACTER inside COMMON or EQUIVALENCE");
  	}
+ 
        return decl;
      }
  
Index: trans-equivalence.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/trans-equivalence.c,v
retrieving revision 1.1.2.3
diff -u -p -c -r1.1.2.3 trans-equivalence.c
*** trans-equivalence.c	28 Sep 2003 06:07:42 -0000	1.1.2.3
--- trans-equivalence.c	27 Nov 2003 04:19:25 -0000
*************** gfc_layout_local_equiv (gfc_symbol * sym
*** 229,241 ****
  {
    gfc_symbol *var;
    HOST_WIDE_INT min_offset;
!   HOST_WIDE_INT max_size;
!   HOST_WIDE_INT offset;
!   HOST_WIDE_INT var_size;
!   tree equiv_decl;
!   tree range;
!   tree array_type;
!   char equiv_name [GFC_MAX_SYMBOL_LEN*2 + 1];
  
    /* The symbol is already layed out.  */
    if ( sym->addr_base )
--- 229,236 ----
  {
    gfc_symbol *var;
    HOST_WIDE_INT min_offset;
!   record_layout_info rli;
!   tree equiv_type, equiv_decl, *field_link;
  
    /* The symbol is already layed out.  */
    if ( sym->addr_base )
*************** gfc_layout_local_equiv (gfc_symbol * sym
*** 245,252 ****
    if ( !sym->equiv_ring )
      return;
  
-   var = sym;
    /* Contains COMMON variables ? If so, return.  */
    do
      {
        /* Global EQUIVALENCE.
--- 240,247 ----
    if ( !sym->equiv_ring )
      return;
  
    /* Contains COMMON variables ? If so, return.  */
+   var = sym;
    do
      {
        /* Global EQUIVALENCE.
*************** gfc_layout_local_equiv (gfc_symbol * sym
*** 258,264 ****
      }
    while (var != sym);
  
!   /* Find the minimize offset.  */
    var = sym;
    min_offset = 0;
    do
--- 253,259 ----
      }
    while (var != sym);
  
!   /* Find the minimal offset.  */
    var = sym;
    min_offset = 0;
    do
*************** gfc_layout_local_equiv (gfc_symbol * sym
*** 269,310 ****
      }
    while (var != sym);
  
!   /* Assign the address offset to each EQUIVALENCE object and calculate the
!      maximum storage size to hold these EQUIVALENCE objects.  */
    var = sym;
-   max_size = 0;
    do
      {
!       offset = var->equiv_offset - min_offset;
!       var->addr_offset = build_int_2 (offset, 0);
  
!       var_size = TREE_INT_CST_LOW (TYPE_SIZE_UNIT (gfc_sym_type (var)))
!                  + offset;
  
!       if (max_size < var_size)
!         max_size = var_size;
  
        var = var->equiv_ring;
      }
    while (var != sym);
  
    /* Make the storage object for this EQUIVALENCE ring.  */
!   range = build_int_2 (max_size - 1, 0);
!   range = build_range_type (gfc_array_index_type, integer_zero_node, range);
!   array_type = build_array_type (gfc_character1_type_node, range);
!   sprintf(equiv_name, "__gfc_equiv_%s", sym->name);
!   equiv_decl = build_decl (VAR_DECL,
!                            get_identifier (equiv_name), array_type);
    DECL_COMMON (equiv_decl) = 1;
    TREE_ADDRESSABLE (equiv_decl) = 1;
    TREE_USED (equiv_decl) = 1;
    gfc_add_decl_to_function (equiv_decl);
  
!   /* Assign the base address to each EQUIVALENCE object.  */
    var = sym;
    do
      {
!       var->addr_base = equiv_decl;
        var = var->equiv_ring;
      }
    while (var != sym);
--- 264,334 ----
      }
    while (var != sym);
  
!   /* Create a union type that will all of the EQUIVALENCE objects.  */
!   equiv_type = make_node (UNION_TYPE);
!   rli = start_record_layout (equiv_type);
!   field_link = &TYPE_FIELDS (equiv_type);
! 
!   /* Create and place a field for each EQUIVALENCE object.  Note that
!      unlike with normal unions, not all fields begin at offset zero.
!      This is the primary reason that we're bypassing layout_type.  */
    var = sym;
    do
      {
!       tree type = gfc_sym_type (var);
!       tree name = get_identifier (var->name);
!       tree field = build_decl (FIELD_DECL, name, type);
!       unsigned int desired_align, known_align;
!       HOST_WIDE_INT offset;
  
!       offset = var->equiv_offset - min_offset;
!       known_align = (offset & -offset) * BITS_PER_UNIT;
!       if (known_align == 0 || known_align > BIGGEST_ALIGNMENT)
! 	known_align = BIGGEST_ALIGNMENT;
! 
!       desired_align = update_alignment_for_field (rli, field, known_align);
!       if (desired_align > known_align)
! 	DECL_PACKED (field) = 1;
! 
!       DECL_FIELD_CONTEXT (field) = equiv_type;
!       DECL_FIELD_OFFSET (field) = size_int (offset);
!       DECL_FIELD_BIT_OFFSET (field) = bitsize_zero_node;
!       SET_DECL_OFFSET_ALIGN (field, known_align);
! 
!       rli->offset = size_binop (MAX_EXPR, rli->offset,
! 				size_binop (PLUS_EXPR,
! 					    DECL_FIELD_OFFSET (field),
! 					    DECL_SIZE_UNIT (field)));
! 
!       /* Link the field into the type.  */
!       *field_link = field;
!       field_link = &TREE_CHAIN (field);
  
!       /* Temporarily store the field_decl in the addr_base field.  */
!       var->addr_base = field;
  
        var = var->equiv_ring;
      }
    while (var != sym);
  
+   finish_record_layout (rli, true);
+ 
    /* Make the storage object for this EQUIVALENCE ring.  */
!   equiv_decl = build_decl (VAR_DECL, NULL, equiv_type);
    DECL_COMMON (equiv_decl) = 1;
    TREE_ADDRESSABLE (equiv_decl) = 1;
    TREE_USED (equiv_decl) = 1;
+   DECL_ARTIFICIAL (equiv_decl) = 1;
+ 
    gfc_add_decl_to_function (equiv_decl);
  
!   /* For each EQUIVALENCE object, make addr_base reference the field
!      we created in the storage object we created.  */
    var = sym;
    do
      {
!       var->addr_base = build (COMPONENT_REF, TREE_TYPE (var->addr_base),
! 			      equiv_decl, var->addr_base);
        var = var->equiv_ring;
      }
    while (var != sym);