Re: GNAT Allocation of a very large record

[Per Sandberg <per.sandberg@sandat.dyndns.org>]

Tried 4 different GCC:s and one failed:
gcc 4.4.7 20120313 (Red Hat 4.4.7-3) (GCC) x86 ok
gcc 4.6.3 20120306 (Red Hat 4.6.3-2) (GCC) x86_64 ok
gcc 4.7.3 20130318 for GNAT Pro 7.2.0w (20130317) (GCC) x86_64 ok
gcc 4.4.5 (Debian 4.4.5-8) arm (raspberry-pi) fail

It seems as there is a bug in your particular instance of GCC as well
as the GCC for the pi.


/Per




On Tue, 13 Aug 2013 20:50:21 -0700 (PDT)
hyunghwan.chung@gmail.com wrote:

> Hi, 
> 
> The program at the bottom of this message, when compiled with GNAT
> 4.6 on Ubuntu12/x86_64, seems to corrupt memory, ending up with a
> malloc error message.
> 
> $ ./x1
> 1. Kind: POINTER_OBJECT Size:  10
> x1: malloc.c:2451: sYSMALLOc: Assertion `(old_top == (((mbinptr)
> (((char *) &((av)->bins[((1) - 1) * 2])) - __builtin_offsetof (struct
> malloc_chunk, fd)))) && old_size == 0) || ((unsigned long) (old_size)
> >= (unsigned long)((((__builtin_offsetof (struct malloc_chunk,
> >fd_nextsize))+((2 * (sizeof(size_t))) - 1)) & ~((2 *
> >(sizeof(size_t))) - 1))) && ((old_top)->size & 0x1) && ((unsigned
> >long)old_end & pagemask) == 0)' failed. ^C
> 
> On some other platforms (i.e. debian/armv5tel, gcc/gnat 4.4.5), just
> segmentation fault.
> 
> I expect an output like this, meaning that the second call to 'new'
> should raise an exception like storage_error.
> 
> $ ./x1
> 1. Kind: POINTER_OBJECT Size:  10
> 2. Allocation Failed
> 
> You'd get the result like above if you changed the upper bound of the
> range of Pointer_Obje



ct_Size from Storage_Count'Last to
> (OBJECT_DATA_BYTES / (Object_Pointer'Max_Size_In_Storage_Elements *
> System.Storage_Unit)).
> 
> The new upper bound has been defined so that
> Pointer_Object_Record'Size don't exceed 2 ** 63 - 1 (System.Max_Int).
> On an 32-bit platform, the upper bound seems to be able to reach
> OBJECT_DATA_BYTES / Object_Pointer'Max_Size_In_Storage_Elements. With
> this upper bound on the 32-bit platform, Pointer_Object_Record'Size
> may go beyond 2 ^ 31 - 1 but
> Pointer_Object_Record'Max_Size_In_Storage_Elements falls below 2 ^ 31
> - 1. 
> 
> Anyway, when the upper bound is set to Storage_Count'Last,
> Pointer_Object_Record'Max_Size_In_Storage_Elements and
> Pointer_Object_Record'Size seem to wrap around to an undesired value
> 
> The problem is that neither Constraint_Error nor Storage_Error is
> raised when the size of a record is very large. I'd like to have a
> graceful way to catch a ridiculously large size given to the function
> and handle the exception properly without ending up with segmentation
> fault or something similar.
> 
> Is it a bug of the GNU Ada compiler or am i doing anything wrong?
> 
> Thanks,
> Hyung-Hwan
> 
> ------------------------------------------------------------------------------- 
> with Ada.Text_IO; 
> with System;
> with Ada.Unchecked_Conversion;
> 
> procedure X1 is
> 
> 	type Storage_Element is mod 2 ** System.Storage_Unit;
> 	for Storage_Element'Size use System.Storage_Unit;
> 	type Storage_Offset is range -(2 ** (System.Word_Size -
> 1)) ..  +(2 ** (System.Word_Size - 1)) - 1; subtype Storage_Count is
> Storage_Offset range 0 .. Storage_Offset'Last;
> 
> 	subtype Object_Byte      is Storage_Element;
> 	subtype Object_Character is Wide_Character;
> 	subtype Object_String    is Wide_String;
> 
> 	type Object_Kind is (Pointer_Object, Character_Object,
> Byte_Object); for Object_Kind use (Pointer_Object => 0,
> Character_Object => 1, Byte_Object => 2);
> 
> 	type Object_Record;
> 	type Object_Pointer is access all Object_Record;
> 
> 	type Byte_Array is array (Storage_Count range <>) of
> Object_Byte; type Character_Array is array (Storage_Count range <>)
> of Object_Character; type Pointer_Array is array (Storage_Count range
> <>) of Object_Pointer;
> 
> 	type Object_Record (Kind: Object_Kind; Size: Storage_Count)
> is record Flags: Standard.Integer range 0 .. 3;-- := 0;
> 		Extra: Standard.Integer range 0 .. 1;-- := 0;
> 		Unit:  Standard.Integer range 0 .. 4;-- := 0;
> 		Class: Object_Pointer;-- := null;
> 
> 		case Kind is
> 			when Pointer_Object =>
> 				Pointer_Slot: Pointer_Array (1 ..
> Size);-- := (Others => null); when Character_Object =>
> 				Character_Slot: Character_Array (0 ..
> Size);-- := (Others => Object_Character'Val(0)); when Byte_Object =>
> 				Byte_Slot: Byte_Array (1 ..
> Size);-- := (Others => 0); end case;
> 	end record;
> 	for Object_Record use record
> 		Kind  at 0 range 0 .. 7;
> 		Flags at 1 range 0 .. 2;
> 		Extra at 1 range 3 .. 3;
> 		Unit  at 1 range 4 .. 7;
> 	end record;
> 
> 	subtype Empty_Object_Record is Object_Record (Byte_Object, 0);
> 	-- the number of bytes in an object header. this is fixed in
> size OBJECT_HEADER_BYTES: constant Storage_Count :=
> Empty_Object_Record'Max_Size_In_Storage_Elements; -- the largest
> number of bytes that an object can hold after the header
> OBJECT_DATA_BYTES: constant Storage_Count := Storage_Count'Last -
> OBJECT_HEADER_BYTES;
> 
> 	subtype Pointer_Object_Size is Storage_Count range
> 		Storage_Count'First .. (OBJECT_DATA_BYTES /
> (Object_Pointer'Max_Size_In_Storage_Elements * System.Storage_Unit));
> --	Storage_Count'First .. Storage_Count'Last;
> 
> 	procedure Alloc_Pointer_Object (Size: in Pointer_Object_Size;
> Result: out Object_Pointer) is subtype Pointer_Object_Record is
> Object_Record (Pointer_Object, Size); type Pointer_Object_Pointer is
> access Pointer_Object_Record; function To_Object_Pointer is new
> Ada.Unchecked_Conversion (Pointer_Object_Pointer, Object_Pointer);
> Ptr: Pointer_Object_Pointer; begin
>    		--Ada.Text_IO.Put_Line
> (Pointer_Object_Record'Size'Img); --Ada.Text_IO.Put_Line
> (Pointer_Object_Record'Max_Size_In_Storage_Elements'Img); Ptr := new
> Pointer_Object_Record'( Kind => Pointer_Object, 
> 			Size => Size,
> 			Flags => 0,
> 			Extra => 0,
> 			Unit => 0,
> 			Class => null,
> 			Pointer_Slot => (others=>null)
> 		);
> 
> 		Result := To_Object_Pointer (Ptr);
> 	exception
> 		when others =>
> 			Result := null;
> 	end Alloc_Pointer_Object;
> 
> 
> 	ObjPtr: Object_Pointer;
> begin
> 
> 	Alloc_Pointer_Object (10, ObjPtr);
> 	if ObjPtr = null then
> 		Ada.Text_IO.Put_Line ("1. Allocation Failed");
> 	else
> 		Ada.Text_IO.Put_Line ("1. Kind: " &
> Object_Kind'Image(ObjPtr.Kind)  & " Size: " &
> Storage_Count'Image(ObjPtr.Size)); end if;
> 
> 	Alloc_Pointer_Object (Pointer_Object_Size'Last, ObjPtr);
> 	if ObjPtr = null then
> 		Ada.Text_IO.Put_Line ("2. Allocation Failed");
> 	else
> 		Ada.Text_IO.Put_Line ("2. Kind: " &
> Object_Kind'Image(ObjPtr.Kind)  & " Size: " &
> Storage_Count'Image(ObjPtr.Size)); end if;
> 
> end X1;