[Ada] Wrong arg to free for super-aligned objects

[Arnaud Charlet <charlet at adacore dot com>]

Tested on i686-linux, committed on trunk

super-aligned objects are those with a requested alignment greater
than what the underlying allocation engine can honor (compiler stack
slot assignment for local objects or, say, malloc for dynamic
allocations).

gigi resorts to "aligning" types to handle these, record types with
one field set at a position arranged to be properly aligned from the
object address.

It currently arranges for "new" to 'malloc'ate such an object and to
return the field's address, which is what the user later on feeds to
unchecked_deallocate.

Nothing is currently done at deallocation time to recover the address
that malloc initially returned, so we end up calling 'free' with the
adjusted address, which is just wrong and can lead various kinds of
misbehavior.

The fix applied here enhances

 o gigi's internal make_aligning_type to accept an extra 'room' argument,
   for storage to be made available before the aligned field

 o the allocator to store the malloc return value in front of the
   aligned field,

 o the deallocator to retrieve the address to 'free' from there.

The testcase below is expected to compile and run silently on platforms
where the large alignment factor is not rejected upfront.

    with ada.text_io; use ada.text_io;
    with System.Storage_Elements; use System.Storage_Elements;
    with Ada.Unchecked_Deallocation;

    procedure PLOG is

       Align : constant := 1024;
       type Block is record
          Value : Integer;
       end record;
       for Block'Alignment use Align;

       type Block_Access is access Block;

       procedure Free is new
         Ada.Unchecked_Deallocation (Block, Block_Access);

       Blocks : array (1 .. 500) of Block_Access;
    begin
       for J in Blocks'Range loop
          Blocks (J) := new Block;
          if blocks(j).all'address mod align /= 0 then
             put_line ("misaligned result !!");
          end if;
       end loop;
       for J in Blocks'Range loop
          Free (Blocks (J));
       end loop;
    end;

What it really should be doing is never calling 'free' with an address
not returned by 'malloc', which it used to de before this change, which
in turn most of the times triggers unexpected visible behavior (explicit
error message from 'free' on some targets, crash on others, ...).

Fix also the following problem which reproduces only on the Windows host and
stems from a non-stabilized quick sort in gnat_build_constructor, which ends up
letting the host choose the order of elements in some corner cases.
gnat.dg/specs/constructor.ads must silently compile everywhere.

2007-06-06  Olivier Hainque  <hainque@adacore.com>
	    Eric Botcazou  <ebotcazou@adacore.com>

	* utils2.c (build_allocator): Provide the extra arguments to
	make_aligning_type for super-aligned objects allocated from the default
	pool. Leave enough room for a pointer before the aligning field, and
	store the system's allocator return value there.
	(build_call_alloc_dealloc): When releasing a super-aligned object,
	retrieve the system's allocator return value from where build_allocator
	has stored it, just ahead of the adjusted address we are passed.
	(build_call_raise): Handle properly the generation of line numbers when
	the node is marked No_Location.
	(compare_elmt_bitpos): Use tree_int_cst_compare.  Stabilize the sort
	by using DECL_UID on ties.
	(build_binary_op) <EQ_EXPR>: Accept fat pointer types with the same
	main variant.
	(build_call_raise): Handle converting exception into goto; support new
	argument KIND.
	(build_component_ref): Add new arg to build_call_raise.

Attachment: difs
Description: Text document