From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=unavailable autolearn_force=no version=3.4.4 Path: eternal-september.org!reader01.eternal-september.org!reader02.eternal-september.org!news.eternal-september.org!news.eternal-september.org!news.eternal-september.org!feeder.eternal-september.org!v102.xanadu-bbs.net!xanadu-bbs.net!news.glorb.com!hitnews.eu!news-out.readnews.com!s09-01.readnews.com!not-for-mail X-Trace: DXC=Jc7mb7g?9af;b37CWD9A`a[3OhcoN[H0`X44`8^\]>7j8DHB_I2k0T`_WOU;SDD77d\Yf]=B1QjAch1[ Newsgroups: comp.lang.ada Subject: Re: GNAT Allocation of a very large record Message-ID: <20130814213210.5ebf41e7@lufsen.sandat.dyndns.org> References: <9de9c3bf-c4c5-466f-a8cd-fca992daecbe@googlegroups.com> X-Newsreader: Claws Mail 3.9.0 (GTK+ 2.24.8; x86_64-redhat-linux-gnu) Mime-Version: 1.0 Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit NNTP-Posting-Host: f8af7764.ngroups.net Xref: news.eternal-september.org comp.lang.ada:16858 Date: 2013-08-14T21:32:10+02:00 List-Id: 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;