[PATCH] support static nested constructors in bitfields (2/2)

Olivier Hainque hainque@adacore.com
Thu Jul 24 12:55:00 GMT 2008


Olivier Hainque wrote:
> This is the second part of the output_constructor rework to let it
> handle nested aggregates in bitfields.

 Sent before attaching the patches. Here there are.

 Cheers,

 Olivier
-------------- next part --------------
*** gcc/varasm.c.ori	Thu Jun 19 20:36:28 2008
--- gcc/varasm.c	Tue Jun 24 18:24:01 2008
*************** static void output_constant_def_contents
*** 118,124 ****
  static void output_addressed_constants (tree);
  static unsigned HOST_WIDE_INT array_size_for_constructor (tree);
  static unsigned min_align (unsigned, unsigned);
- static void output_constructor (tree, unsigned HOST_WIDE_INT, unsigned int);
  static void globalize_decl (tree);
  #ifdef BSS_SECTION_ASM_OP
  #ifdef ASM_OUTPUT_BSS
--- 118,123 ----
*************** initializer_constant_valid_p (tree value
*** 4318,4323 ****
--- 4317,4371 ----
    return 0;
  }
  
+ /* Return true if VALUE is a valid constant-valued expression
+    for use in initializing a static bit-field; one that can be
+    an element of a "constant" initializer.  */
+ 
+ bool
+ initializer_constant_valid_for_bitfield_p (tree value)
+ {
+   /* For bitfields we support integer constants or possibly nested aggregates
+      of such.  */
+   switch (TREE_CODE (value))
+     {
+     case CONSTRUCTOR:
+       {
+ 	unsigned HOST_WIDE_INT idx;
+ 	tree elt;
+ 
+ 	FOR_EACH_CONSTRUCTOR_VALUE (CONSTRUCTOR_ELTS (value), idx, elt)
+ 	  if (!initializer_constant_valid_for_bitfield_p (elt))
+ 	    return false;
+ 	return true;
+       }
+ 
+     case INTEGER_CST:
+       return true;
+ 
+     case VIEW_CONVERT_EXPR:
+     case NON_LVALUE_EXPR:
+       return
+ 	initializer_constant_valid_for_bitfield_p (TREE_OPERAND (value, 0));
+ 
+     default:
+       break;
+     }
+ 
+   return false;
+ }
+ 
+ /* output_constructor outer state of relevance in recursive calls, typically
+    for nested aggregate bitfields.  */
+ 
+ typedef struct {
+   unsigned int bit_offset;  /* current position in ...  */
+   int byte;                 /* ... the outer byte buffer.  */
+ } oc_outer_state;
+ 
+ static unsigned HOST_WIDE_INT
+   output_constructor (tree, unsigned HOST_WIDE_INT, unsigned int,
+ 		      oc_outer_state *);
+ 
  /* Output assembler code for constant EXP to FILE, with no label.
     This includes the pseudo-op such as ".int" or ".byte", and a newline.
     Assumes output_addressed_constants has been done on EXP already.
*************** output_constant (tree exp, unsigned HOST
*** 4456,4462 ****
        switch (TREE_CODE (exp))
  	{
  	case CONSTRUCTOR:
! 	  output_constructor (exp, size, align);
  	  return;
  	case STRING_CST:
  	  thissize = MIN ((unsigned HOST_WIDE_INT)TREE_STRING_LENGTH (exp),
--- 4504,4510 ----
        switch (TREE_CODE (exp))
  	{
  	case CONSTRUCTOR:
! 	    output_constructor (exp, size, align, NULL);
  	  return;
  	case STRING_CST:
  	  thissize = MIN ((unsigned HOST_WIDE_INT)TREE_STRING_LENGTH (exp),
*************** output_constant (tree exp, unsigned HOST
*** 4494,4500 ****
      case RECORD_TYPE:
      case UNION_TYPE:
        gcc_assert (TREE_CODE (exp) == CONSTRUCTOR);
!       output_constructor (exp, size, align);
        return;
  
      case ERROR_MARK:
--- 4542,4548 ----
      case RECORD_TYPE:
      case UNION_TYPE:
        gcc_assert (TREE_CODE (exp) == CONSTRUCTOR);
!       output_constructor (exp, size, align, NULL);
        return;
  
      case ERROR_MARK:
*************** array_size_for_constructor (tree val)
*** 4550,4558 ****
    return tree_low_cst (i, 1);
  }
  
! /* Datastructures and helpers for output_constructor.  */
  
! /* Local output_constructor state to support interaction with helpers.  */
  
  typedef struct {
  
--- 4598,4606 ----
    return tree_low_cst (i, 1);
  }
  
! /* Other datastructures + helpers for output_constructor.  */
  
! /* output_constructor local state to support interaction with helpers.  */
  
  typedef struct {
  
*************** typedef struct {
*** 4568,4588 ****
  
    /* Output processing state per se.  */
    HOST_WIDE_INT total_bytes;  /* # bytes output so far / current position.  */
!   int byte_buffer_in_use;     /* whether byte ...  */
    int byte;                   /* ... contains part of a bitfield byte yet to
  			         be output.  */
  
    /* Current element.  */
    tree val;    /* current element value.  */
    tree index;  /* current element index.  */
  
  } oc_local_state;
  
! static void output_constructor_array_range (oc_local_state *);
! static void output_constructor_regular_field (oc_local_state *);
! static void output_constructor_bitfield (oc_local_state *);
  
! /* Helper for output_constructor.  Output a RANGE_EXPR element.  */
  
  static void
  output_constructor_array_range (oc_local_state *local)
--- 4616,4639 ----
  
    /* Output processing state per se.  */
    HOST_WIDE_INT total_bytes;  /* # bytes output so far / current position.  */
!   bool byte_buffer_in_use;    /* whether byte ...  */
    int byte;                   /* ... contains part of a bitfield byte yet to
  			         be output.  */
  
+   int last_relative_index;    /* Implicit or explicit index of the last
+ 				 array element output within a bitfield.  */
    /* Current element.  */
    tree val;    /* current element value.  */
    tree index;  /* current element index.  */
  
  } oc_local_state;
  
! static void output_constructor_array_range (oc_local_state *);
! static void output_constructor_regular_field (oc_local_state *);
! static void output_constructor_bitfield (oc_local_state *, oc_outer_state *);
  
! /* Helper for output_constructor.  From the current LOCAL state, output a
!    RANGE_EXPR element.  */
  
  static void
  output_constructor_array_range (oc_local_state *local)
*************** output_constructor_array_range (oc_local
*** 4612,4619 ****
      }
  }
  
! /* Helper for output_constructor.  Output a field element that is not
!    bitfield.  */
  
  static void
  output_constructor_regular_field (oc_local_state *local)
--- 4663,4670 ----
      }
  }
  
! /* Helper for output_constructor.  From the current LOCAL state, output a
!    field element that is not true bitfield or part of an outer one.  */
  
  static void
  output_constructor_regular_field (oc_local_state *local)
*************** output_constructor_regular_field (oc_loc
*** 4635,4641 ****
      {
        assemble_integer (GEN_INT (local->byte), 1, BITS_PER_UNIT, 1);
        local->total_bytes++;
!       local->byte_buffer_in_use = 0;
      }
    
    /* Advance to offset of this element.
--- 4686,4692 ----
      {
        assemble_integer (GEN_INT (local->byte), 1, BITS_PER_UNIT, 1);
        local->total_bytes++;
!       local->byte_buffer_in_use = false;
      }
    
    /* Advance to offset of this element.
*************** output_constructor_regular_field (oc_loc
*** 4691,4716 ****
    local->total_bytes += fieldsize;
  }
  
! /* Helper for output_constructor.  Output a bitfield element.  */
  
  static void
! output_constructor_bitfield (oc_local_state *local)
  {
!   /* Offset in bits from the beginning of the structure to the next bit of
!      this element to be processed.  */
!   HOST_WIDE_INT next_offset = int_bit_position (local->field);
! 
!   /* Offset of the first bit past the end of this element.  */
!   HOST_WIDE_INT end_offset
!     = (next_offset + tree_low_cst (DECL_SIZE (local->field), 1));
    
-   if (local->val != 0 && TREE_CODE (local->val) != INTEGER_CST)
-     error ("invalid initial value for member %qs",
- 	   IDENTIFIER_POINTER (DECL_NAME (local->field)));
- 
    if (local->val == 0)
      local->val = integer_zero_node;
    
    /* If this field does not start in this (or, next) byte,
       skip some bytes.  */
    if (next_offset / BITS_PER_UNIT != local->total_bytes)
--- 4742,4800 ----
    local->total_bytes += fieldsize;
  }
  
! /* Helper for output_constructor.  From the current LOCAL and OUTER states,
!    output an element that is a true bitfield or part of an outer one.  */
  
  static void
! output_constructor_bitfield (oc_local_state *local, oc_outer_state *outer)
  {
!   /* Bit size of this element.  */
!   HOST_WIDE_INT ebitsize
!     = (local->field
!        ? tree_low_cst (DECL_SIZE (local->field), 1)
!        : tree_low_cst (TYPE_SIZE (TREE_TYPE (local->type)), 1));
! 
!   /* Relative index of this element if this is an array component.  */
!   HOST_WIDE_INT relative_index
!     = (!local->field
!        ? (local->index
! 	  ? (tree_low_cst (local->index, 0) 
! 	     - tree_low_cst (local->min_index, 0))
! 	  : local->last_relative_index + 1)
!        : 0);
!   
!   /* Bit position of this element from the start of the containing
!      constructor.  */
!   HOST_WIDE_INT constructor_relative_ebitpos
!       = (local->field
! 	 ? int_bit_position (local->field) 
! 	 : ebitsize * relative_index);
!   
!   /* Bit position of this element from the start of a possibly ongoing
!      outer byte buffer.  */
!   HOST_WIDE_INT byte_relative_ebitpos
!       = ((outer ? outer->bit_offset : 0) + constructor_relative_ebitpos);
! 
!   /* From the start of a possibly ongoing outer byte buffer, offsets to 
!      the first bit of this element and to the first bit past the end of
!      this element.  */
!   HOST_WIDE_INT next_offset = byte_relative_ebitpos;
!   HOST_WIDE_INT end_offset = byte_relative_ebitpos + ebitsize;
!   
!   local->last_relative_index = relative_index;
    
    if (local->val == 0)
      local->val = integer_zero_node;
    
+   while (TREE_CODE (local->val) == VIEW_CONVERT_EXPR
+ 	 || TREE_CODE (local->val) == NON_LVALUE_EXPR)
+     local->val = TREE_OPERAND (local->val, 0);
+     
+   if (TREE_CODE (local->val) != INTEGER_CST
+       && TREE_CODE (local->val) != CONSTRUCTOR)
+       error ("invalid initial value for member %qs",
+ 	     IDENTIFIER_POINTER (DECL_NAME (local->field)));
+ 
    /* If this field does not start in this (or, next) byte,
       skip some bytes.  */
    if (next_offset / BITS_PER_UNIT != local->total_bytes)
*************** output_constructor_bitfield (oc_local_st
*** 4720,4726 ****
  	{
  	  assemble_integer (GEN_INT (local->byte), 1, BITS_PER_UNIT, 1);
  	  local->total_bytes++;
! 	  local->byte_buffer_in_use = 0;
  	}
        
        /* If still not at proper byte, advance to there.  */
--- 4804,4810 ----
  	{
  	  assemble_integer (GEN_INT (local->byte), 1, BITS_PER_UNIT, 1);
  	  local->total_bytes++;
! 	  local->byte_buffer_in_use = false;
  	}
        
        /* If still not at proper byte, advance to there.  */
*************** output_constructor_bitfield (oc_local_st
*** 4732,4744 ****
  	}
      }
    
!   if (! local->byte_buffer_in_use)
!     local->byte = 0;
    
!   /* We must split the element into pieces that fall within
!      separate bytes, and combine each byte with previous or
!      following bit-fields.  */
    
    while (next_offset < end_offset)
      {
        int this_time;
--- 4816,4846 ----
  	}
      }
    
!   /* Set up the buffer if necessary.  */
!   if (!local->byte_buffer_in_use)
!     {
!       local->byte = 0;
!       if (ebitsize > 0)
! 	local->byte_buffer_in_use = true;
!     }
    
!   /* If this is nested constructor, recurse passing the bit offset and the
!      pending data, then retrieve the new pending data afterwards.  */
!   if (TREE_CODE (local->val) == CONSTRUCTOR)
!     {
!       oc_outer_state output_state;
! 
!       output_state.bit_offset = next_offset % BITS_PER_UNIT;
!       output_state.byte = local->byte;
!       local->total_bytes
! 	  += output_constructor (local->val, 0, 0, &output_state);
!       local->byte = output_state.byte;
!       return;
!     }
    
+   /* Otherwise, we must split the element into pieces that fall within
+      separate bytes, and combine each byte with previous or following
+      bit-fields.  */  
    while (next_offset < end_offset)
      {
        int this_time;
*************** output_constructor_bitfield (oc_local_st
*** 4800,4806 ****
  	     take first the least significant bits of the value
  	     and pack them starting at the least significant
  	     bits of the bytes.  */
! 	  shift = next_offset - int_bit_position (local->field);
  	  
  	  /* Don't try to take a bunch of bits that cross
  	     the word boundary in the INTEGER_CST. We can
--- 4902,4908 ----
  	     take first the least significant bits of the value
  	     and pack them starting at the least significant
  	     bits of the bytes.  */
! 	  shift = next_offset - byte_relative_ebitpos;
  	  
  	  /* Don't try to take a bunch of bits that cross
  	     the word boundary in the INTEGER_CST. We can
*************** output_constructor_bitfield (oc_local_st
*** 4828,4843 ****
  	}
        
        next_offset += this_time;
!       local->byte_buffer_in_use = 1;
      }
  }
  
  /* Subroutine of output_constant, used for CONSTRUCTORs (aggregate constants).
!    Generate at least SIZE bytes, padding if necessary.  */
  
! static void
  output_constructor (tree exp, unsigned HOST_WIDE_INT size,
! 		    unsigned int align)
  {
    unsigned HOST_WIDE_INT cnt;
    constructor_elt *ce;
--- 4930,4946 ----
  	}
        
        next_offset += this_time;
!       local->byte_buffer_in_use = true;
      }
  }
  
  /* Subroutine of output_constant, used for CONSTRUCTORs (aggregate constants).
!    Generate at least SIZE bytes, padding if necessary.  OUTER designates the
!    caller output state of relevance in recursive invocations.  */
  
! static unsigned HOST_WIDE_INT
  output_constructor (tree exp, unsigned HOST_WIDE_INT size,
! 		    unsigned int align, oc_outer_state * outer)
  {
    unsigned HOST_WIDE_INT cnt;
    constructor_elt *ce;
*************** output_constructor (tree exp, unsigned H
*** 4850,4860 ****
    local.align = align;
  
    local.total_bytes = 0;
!   local.byte_buffer_in_use = 0;
!   local.byte = 0;
  
    local.type = TREE_TYPE (exp);
  
    local.min_index = 0;
    if (TREE_CODE (local.type) == ARRAY_TYPE
        && TYPE_DOMAIN (local.type) != 0)
--- 4953,4965 ----
    local.align = align;
  
    local.total_bytes = 0;
!   local.byte_buffer_in_use = outer != NULL;
!   local.byte = outer ? outer->byte : 0;
  
    local.type = TREE_TYPE (exp);
  
+   local.last_relative_index = -1;
+ 
    local.min_index = 0;
    if (TREE_CODE (local.type) == ARRAY_TYPE
        && TYPE_DOMAIN (local.type) != 0)
*************** output_constructor (tree exp, unsigned H
*** 4908,4934 ****
  
        /* Output the current element, using the appropriate helper ...  */
  
!       /* For an array slice.  */
!       if (local.index && TREE_CODE (local.index) == RANGE_EXPR)
  	output_constructor_array_range (&local);
  
!       /* For a field that is not a bitfield.  */
!       else if (local.field == 0 || !DECL_BIT_FIELD (local.field))
  	output_constructor_regular_field (&local);
! 
!       /* For a bitfield.  */
        else
! 	output_constructor_bitfield (&local);
      }
  
!   if (local.byte_buffer_in_use)
      {
!       assemble_integer (GEN_INT (local.byte), 1, BITS_PER_UNIT, 1);
!       local.total_bytes++;
!     }
  
!   if ((unsigned HOST_WIDE_INT)local.total_bytes < size)
!     assemble_zeros (size - local.total_bytes);
  }
  
  /* This TREE_LIST contains any weak symbol declarations waiting
--- 5013,5056 ----
  
        /* Output the current element, using the appropriate helper ...  */
  
!       /* For an array slice not part of an outer bitfield.  */
!       if (!outer
! 	  && local.index && TREE_CODE (local.index) == RANGE_EXPR)
  	output_constructor_array_range (&local);
  
!       /* For a field that is neither a true bitfield nor part of an outer one,
! 	 known to be at least byte aligned and multiple-of-bytes long.  */
!       else if (!outer
! 	       && (local.field == 0
! 		   || !DECL_BIT_FIELD (local.field)
! 		   || DECL_MODE (local.field) == BLKmode))
  	output_constructor_regular_field (&local);
!       
!       /* For a true bitfield or part of an outer one.  */
        else
! 	output_constructor_bitfield (&local, outer);
      }
  
!   /* If we are not at toplevel, save the pending data for our caller.
!      Otherwise output the pending data and padding zeros as needed. */
!   if (outer)
!     outer->byte = local.byte;
!   else
      {
!       if (local.byte_buffer_in_use)
! 	{
! 	  assemble_integer (GEN_INT (local.byte), 1, BITS_PER_UNIT, 1);
! 	  local.total_bytes++;
! 	}
  
!       if ((unsigned HOST_WIDE_INT)local.total_bytes < local.size)
! 	{
! 	  assemble_zeros (local.size - local.total_bytes);
! 	  local.total_bytes = local.size;
! 	}
!     }
!       
!   return local.total_bytes;
  }
  
  /* This TREE_LIST contains any weak symbol declarations waiting
*** gcc/output.h.ori	Wed Jun 25 09:36:31 2008
--- gcc/output.h	Fri Jun 20 00:51:50 2008
*************** extern bool constructor_static_from_elts
*** 296,301 ****
--- 296,306 ----
     arithmetic-combinations of integers.  */
  extern tree initializer_constant_valid_p (tree, tree);
  
+ /* Return true if VALUE is a valid constant-valued expression
+    for use in initializing a static bit-field; one that can be
+    an element of a "constant" initializer.  */
+ extern bool initializer_constant_valid_for_bitfield_p (tree);
+ 
  /* Output assembler code for constant EXP to FILE, with no label.
     This includes the pseudo-op such as ".int" or ".byte", and a newline.
     Assumes output_addressed_constants has been done on EXP already.
-------------- next part --------------
*** utils2.c.ori	Fri Jun 20 01:04:40 2008
--- utils2.c	Fri Jun 20 01:04:52 2008
*************** compare_elmt_bitpos (const PTR rt1, cons
*** 1629,1662 ****
  tree
  gnat_build_constructor (tree type, tree list)
  {
-   tree elmt;
-   int n_elmts;
    bool allconstant = (TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST);
    bool side_effects = false;
!   tree result;
  
    /* Scan the elements to see if they are all constant or if any has side
       effects, to let us set global flags on the resulting constructor.  Count
       the elements along the way for possible sorting purposes below.  */
    for (n_elmts = 0, elmt = list; elmt; elmt = TREE_CHAIN (elmt), n_elmts ++)
      {
!       if (!TREE_CONSTANT (TREE_VALUE (elmt))
  	  || (TREE_CODE (type) == RECORD_TYPE
! 	      && DECL_BIT_FIELD (TREE_PURPOSE (elmt))
! 	      && TREE_CODE (TREE_VALUE (elmt)) != INTEGER_CST)
! 	  || !initializer_constant_valid_p (TREE_VALUE (elmt),
! 					    TREE_TYPE (TREE_VALUE (elmt))))
  	allconstant = false;
  
!       if (TREE_SIDE_EFFECTS (TREE_VALUE (elmt)))
  	side_effects = true;
  
        /* Propagate an NULL_EXPR from the size of the type.  We won't ever
  	 be executing the code we generate here in that case, but handle it
  	 specially to avoid the compiler blowing up.  */
        if (TREE_CODE (type) == RECORD_TYPE
! 	  && (0 != (result
! 		    = contains_null_expr (DECL_SIZE (TREE_PURPOSE (elmt))))))
  	return build1 (NULL_EXPR, type, TREE_OPERAND (result, 0));
      }
  
--- 1629,1664 ----
  tree
  gnat_build_constructor (tree type, tree list)
  {
    bool allconstant = (TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST);
    bool side_effects = false;
!   tree elmt, result;
!   int n_elmts;
  
    /* Scan the elements to see if they are all constant or if any has side
       effects, to let us set global flags on the resulting constructor.  Count
       the elements along the way for possible sorting purposes below.  */
    for (n_elmts = 0, elmt = list; elmt; elmt = TREE_CHAIN (elmt), n_elmts ++)
      {
!       tree obj = TREE_PURPOSE (elmt);
!       tree val = TREE_VALUE (elmt);
! 
!       /* The predicate must be in keeping with output_constructor.  */
!       if (!TREE_CONSTANT (val)
  	  || (TREE_CODE (type) == RECORD_TYPE
! 	      && DECL_BIT_FIELD (obj)
! 	      && DECL_MODE (obj) != BLKmode
! 	      && !initializer_constant_valid_for_bitfield_p (val))
! 	  || !initializer_constant_valid_p (val, TREE_TYPE (val)))
  	allconstant = false;
  
!       if (TREE_SIDE_EFFECTS (val))
  	side_effects = true;
  
        /* Propagate an NULL_EXPR from the size of the type.  We won't ever
  	 be executing the code we generate here in that case, but handle it
  	 specially to avoid the compiler blowing up.  */
        if (TREE_CODE (type) == RECORD_TYPE
! 	  && (result = contains_null_expr (DECL_SIZE (obj))) != NULL_TREE)
  	return build1 (NULL_EXPR, type, TREE_OPERAND (result, 0));
      }
  
-------------- next part --------------
*** testsuite/gnat.dg/oconst1.ads	(revision 0)
--- testsuite/gnat.dg/oconst1.ads	(revision 0)
***************
*** 0 ****
--- 1,25 ----
+ package OCONST1 is
+ 
+   type u8 is mod 2**8;
+ 
+   type Base is record
+     i1 : Integer;
+     i2 : Integer;
+     i3 : Integer;
+   end Record;
+ 
+   type R is record
+     u : u8;
+     b : Base;
+   end record;
+ 
+   for R use record
+     u at 0 range 0 .. 7;
+     b at 1 range 0 .. 95;  -- BLKmode bitfield
+   end record;
+ 
+   My_R : constant R := (u=>1, b=>(2, 3, 4));
+ 
+   procedure check (arg : R);
+ 
+ end;
*** testsuite/gnat.dg/oconst1.adb	(revision 0)
--- testsuite/gnat.dg/oconst1.adb	(revision 0)
***************
*** 0 ****
--- 1,18 ----
+ -- { dg-do compile }
+ -- { dg-final { scan-assembler-not "elabs" } }
+ 
+ package body OCONST1 is
+ 
+   procedure check (arg : R) is
+   begin
+     if arg.u /= 1
+        or else arg.b.i1 /= 2
+        or else arg.b.i2 /= 3
+        or else arg.b.i3 /= 4
+     then
+       raise Program_Error;
+     end if;
+   end;
+ 
+ end;
+ 
*** testsuite/gnat.dg/oconst2.ads	(revision 0)
--- testsuite/gnat.dg/oconst2.ads	(revision 0)
***************
*** 0 ****
--- 1,23 ----
+ package OCONST2 is
+ 
+   type u8 is mod 2**8;
+ 
+   type Base is record
+     i1 : Integer;
+   end Record;
+ 
+   type R is record
+     u : u8;
+     b : Base;
+   end record;
+ 
+   for R use record
+     u at 0 range 0 .. 7;
+     b at 1 range 0 .. 31;  -- aligned SImode bitfield
+   end record;
+ 
+   My_R : constant R := (u=>1, b=>(i1=>2));
+ 
+   procedure check (arg : R);
+ 
+ end;
*** testsuite/gnat.dg/oconst2.adb	(revision 0)
--- testsuite/gnat.dg/oconst2.adb	(revision 0)
***************
*** 0 ****
--- 1,15 ----
+ -- { dg-do compile }
+ -- { dg-final { scan-assembler-not "elabs" } }
+ 
+ package body OCONST2 is
+ 
+   procedure check (arg : R) is
+   begin
+     if arg.u /= 1
+        or else arg.b.i1 /= 2
+     then
+       raise Program_Error;
+     end if;
+   end;
+ 
+ end;
*** testsuite/gnat.dg/oconst3.ads	(revision 0)
--- testsuite/gnat.dg/oconst3.ads	(revision 0)
***************
*** 0 ****
--- 1,26 ----
+ package OCONST3 is
+ 
+   type bit is (zero, one);
+   type u8 is mod 2**8;
+ 
+   type Base is record
+     i1 : Integer;
+   end Record;
+ 
+   type R is record
+     u : u8;
+     f : bit;
+     b : Base;
+   end record;
+ 
+   for R use record
+     u at 0 range 0 .. 7;
+     f at 1 range 0 .. 0;
+     b at 1 range 1 .. 32;  -- unaligned SImode bitfield
+   end record;
+ 
+   My_R : constant R := (u=>1, f=>one, b=>(i1=>3));
+ 
+   procedure check (arg : R);
+ 
+ end;
*** testsuite/gnat.dg/oconst3.adb	(revision 0)
--- testsuite/gnat.dg/oconst3.adb	(revision 0)
***************
*** 0 ****
--- 1,16 ----
+ -- { dg-do compile }
+ -- { dg-final { scan-assembler-not "elabs" } }
+ 
+ package body OCONST3 is
+ 
+   procedure check (arg : R) is
+   begin
+     if arg.u /= 1
+        or else arg.f /= one
+        or else arg.b.i1 /= 3
+     then
+       raise Program_Error;
+     end if;
+   end;
+ 
+ end;
*** testsuite/gnat.dg/oconst4.ads	(revision 0)
--- testsuite/gnat.dg/oconst4.ads	(revision 0)
***************
*** 0 ****
--- 1,66 ----
+ package OCONST4 is
+ 
+   type bit is (zero, one);
+   type u2 is mod 2**2;
+   type u5 is mod 2**5;
+   type u8 is mod 2**8;
+ 
+   type Base is record
+     f1 : bit;
+     f2 : u2;
+     f3 : u5;
+     f4 : u8;
+   end record;
+ 
+   for Base use record
+     f1 at 0 range  0 .. 0;
+     f2 at 0 range  1 .. 2;
+     f3 at 0 range  3 .. 7;
+     f4 at 1 range  0 .. 7;
+   end record;
+ 
+   type Derived is record
+     f1 : u5;
+     b  : Base;
+     f2 : bit;
+     f3 : u2;
+     f4 : u8;
+     i1 : Integer;
+     i2 : Integer;
+   end record;
+ 
+   for Derived use record
+     f1 at 0 range  0 ..  4;
+     b  at 0 range  5 .. 20;  -- unaligned HImode bitfield
+     f2 at 0 range 21 .. 21;
+     f3 at 0 range 22 .. 23;
+     f4 at 0 range 24 .. 31;
+     i1 at 4 range  0 .. 31;
+     i2 at 8 range  0 .. 31;
+   end record;
+ 
+   type R is record
+     u : u8;
+     d : Derived;
+   end record;
+ 
+   for R use record
+     u at 0 range 0 .. 7;
+     d at 1 range 0 .. 95;  -- BLKmode bitfield
+   end record;
+ 
+   My_R : constant R := (u=>1,
+                         d=>(f1=>17,
+                             b=>(f1=>one,
+                                 f2=>2,
+                                 f3=>17,
+                                 f4=>42),
+                             f2=>one,
+                             f3=>1,
+                             f4=>111,
+                             i1=>2,
+                             i2=>3));
+ 
+   procedure check (arg : R);
+ 
+ end;
*** testsuite/gnat.dg/oconst4.adb	(revision 0)
--- testsuite/gnat.dg/oconst4.adb	(revision 0)
***************
*** 0 ****
--- 1,24 ----
+ -- { dg-do compile }
+ -- { dg-final { scan-assembler-not "elabs" } }
+ 
+ package body OCONST4 is
+ 
+   procedure check (arg : R) is
+   begin
+     if arg.u /= 1
+        or else arg.d.f1 /= 17
+        or else arg.d.b.f1 /= one
+        or else arg.d.b.f2 /= 2
+        or else arg.d.b.f3 /= 17
+        or else arg.d.b.f4 /= 42
+        or else arg.d.f2 /= one
+        or else arg.d.f3 /= 1
+        or else arg.d.f4 /= 111
+        or else arg.d.i1 /= 2
+        or else arg.d.i2 /= 3
+     then
+       raise Program_Error;
+     end if;
+   end;
+ 
+ end;
*** testsuite/gnat.dg/oconst5.ads	(revision 0)
--- testsuite/gnat.dg/oconst5.ads	(revision 0)
***************
*** 0 ****
--- 1,27 ----
+ package OCONST5 is
+ 
+   type u1 is mod 2**1;
+   type u8 is mod 2**8;
+ 
+   type HI_Record is record
+     A, B : U8;
+   end record;
+   pragma Suppress_Initialization (HI_Record);
+ 
+   type R is record
+      Bit : U1;
+      Agg : HI_Record;
+   end record;
+   pragma Suppress_Initialization (R);
+ 
+   for R use record
+      Bit at 0 range  0 .. 0;
+      Agg at 0 range  1 .. 16;
+   end record;
+ 
+   My_R0 : R := (Bit => 0, Agg => (A => 3, B => 7));
+   My_R1 : R := (Bit => 1, Agg => (A => 3, B => 7));
+ 
+   procedure Check (Arg : R; Bit : U1);
+ 
+ end;
*** testsuite/gnat.dg/oconst5.adb	(revision 0)
--- testsuite/gnat.dg/oconst5.adb	(revision 0)
***************
*** 0 ****
--- 1,15 ----
+ -- { dg-do compile }
+ -- { dg-final { scan-assembler-not "elabs" } }
+ 
+ package body OCONST5 is
+ 
+    procedure Check (Arg : R; Bit : U1) is
+    begin
+       if Arg.Bit /= Bit
+         or else Arg.Agg.A /= 3
+         or else Arg.Agg.B /= 7
+       then
+          raise Program_Error;
+       end if;
+    end;
+ end;
*** testsuite/gnat.dg/oconst6.ads	(revision 0)
--- testsuite/gnat.dg/oconst6.ads	(revision 0)
***************
*** 0 ****
--- 1,18 ----
+ -- { dg-do compile }
+ -- { dg-final { scan-assembler-not "elabs" } }
+ 
+ package OCONST6 is
+ 
+    type Sequence is array (1 .. 1) of Natural;
+ 
+    type Message is record
+       Data : Sequence;
+    end record;
+ 
+    for Message'Alignment use 1;
+    pragma PACK (Message);
+ 
+    ACK : Message := (Data => (others => 1));
+ 
+ end;
+ 
*** testsuite/gnat.dg/test_oconst.adb	(revision 0)
--- testsuite/gnat.dg/test_oconst.adb	(revision 0)
***************
*** 0 ****
--- 1,13 ----
+ --  { dg-do run }
+ 
+ with OCONST1, OCONST2, OCONST3, OCONST4, OCONST5;
+ 
+ procedure Test_Oconst is
+ begin
+   OCONST1.check (OCONST1.My_R);
+   OCONST2.check (OCONST2.My_R);
+   OCONST3.check (OCONST3.My_R);
+   OCONST4.check (OCONST4.My_R);
+   OCONST5.check (OCONST5.My_R0, 0);
+   OCONST5.check (OCONST5.My_R1, 1);
+ end;


More information about the Gcc-patches mailing list