diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-parame.adb | 28 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-parame.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-parame__ae653.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-parame__hpux.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-parame__rtems.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-parame__vxworks.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-parame__vxworks.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/libgnat/s-secsta.adb | 79 |
9 files changed, 64 insertions, 95 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1d19333..8ff1a13 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2018-01-11 Patrick Bernardi <bernardi@adacore.com> + + * libgnat/s-parame*.adb, libgnat/s-parame*.ads: Remove unneeded + Default_Sec_Stack_Size. + * libgnat/s-secsta.adb (SS_Allocate): Handle the fixed secondary stack + limit check so that the integer index does not overflow. Check the + dynamic stack allocation does not cause the secondary stack pointer to + overflow. + (SS_Info): Align colons. + (SS_Init): Cover the case when bootstraping with an old compiler that + does not set Default_SS_Size. + 2018-01-11 Ed Schonberg <schonberg@adacore.com> * sem_ch3.adb (Add_Internal_Interface_Entities): When checking the diff --git a/gcc/ada/libgnat/s-parame.adb b/gcc/ada/libgnat/s-parame.adb index 359edac..0f4d45f 100644 --- a/gcc/ada/libgnat/s-parame.adb +++ b/gcc/ada/libgnat/s-parame.adb @@ -50,34 +50,6 @@ package body System.Parameters is end if; end Adjust_Storage_Size; - ---------------------------- - -- Default_Sec_Stack_Size -- - ---------------------------- - - function Default_Sec_Stack_Size return Size_Type is - Default_SS_Size : Integer; - pragma Import (C, Default_SS_Size, - "__gnat_default_ss_size"); - begin - -- There are two situations where the default secondary stack size is - -- set to zero: - -- - -- * The user sets it to zero erroneously thinking it will disable - -- the secondary stack. - -- - -- * Or more likely, we are building with an old compiler and - -- Default_SS_Size is never set. - -- - -- In both case set the default secondary stack size to the run-time - -- default. - - if Default_SS_Size > 0 then - return Size_Type (Default_SS_Size); - else - return Runtime_Default_Sec_Stack_Size; - end if; - end Default_Sec_Stack_Size; - ------------------------ -- Default_Stack_Size -- ------------------------ diff --git a/gcc/ada/libgnat/s-parame.ads b/gcc/ada/libgnat/s-parame.ads index 60a5e99..6cad3e7 100644 --- a/gcc/ada/libgnat/s-parame.ads +++ b/gcc/ada/libgnat/s-parame.ads @@ -93,10 +93,6 @@ package System.Parameters is -- The run-time chosen default size for secondary stacks that may be -- overriden by the user with the use of binder -D switch. - function Default_Sec_Stack_Size return Size_Type; - -- The default initial size for secondary stacks that reflects any user - -- specified default via the binder -D switch. - Sec_Stack_Dynamic : constant Boolean := True; -- Indicates if secondary stacks can grow and shrink at run-time. If False, -- the size of a secondary stack is fixed at the point of its creation. diff --git a/gcc/ada/libgnat/s-parame__ae653.ads b/gcc/ada/libgnat/s-parame__ae653.ads index 42d438e..68da0c9 100644 --- a/gcc/ada/libgnat/s-parame__ae653.ads +++ b/gcc/ada/libgnat/s-parame__ae653.ads @@ -93,10 +93,6 @@ package System.Parameters is -- The run-time chosen default size for secondary stacks that may be -- overriden by the user with the use of binder -D switch. - function Default_Sec_Stack_Size return Size_Type; - -- The default size for secondary stacks that reflects any user specified - -- default via the binder -D switch. - Sec_Stack_Dynamic : constant Boolean := False; -- Indicates if secondary stacks can grow and shrink at run-time. If False, -- the size of a secondary stack is fixed at the point of its creation. diff --git a/gcc/ada/libgnat/s-parame__hpux.ads b/gcc/ada/libgnat/s-parame__hpux.ads index 846b1655..e8ced87 100644 --- a/gcc/ada/libgnat/s-parame__hpux.ads +++ b/gcc/ada/libgnat/s-parame__hpux.ads @@ -91,10 +91,6 @@ package System.Parameters is -- The run-time chosen default size for secondary stacks that may be -- overriden by the user with the use of binder -D switch. - function Default_Sec_Stack_Size return Size_Type; - -- The default initial size for secondary stacks that reflects any user - -- specified default via the binder -D switch. - Sec_Stack_Dynamic : constant Boolean := True; -- Indicates if secondary stacks can grow and shrink at run-time. If False, -- the size of a secondary stack is fixed at the point of its creation. diff --git a/gcc/ada/libgnat/s-parame__rtems.adb b/gcc/ada/libgnat/s-parame__rtems.adb index 5a19c43..551eb36 100644 --- a/gcc/ada/libgnat/s-parame__rtems.adb +++ b/gcc/ada/libgnat/s-parame__rtems.adb @@ -56,18 +56,6 @@ package body System.Parameters is end if; end Adjust_Storage_Size; - ---------------------------- - -- Default_Sec_Stack_Size -- - ---------------------------- - - function Default_Sec_Stack_Size return Size_Type is - Default_SS_Size : Integer; - pragma Import (C, Default_SS_Size, - "__gnat_default_ss_size"); - begin - return Size_Type (Default_SS_Size); - end Default_Sec_Stack_Size; - ------------------------ -- Default_Stack_Size -- ------------------------ diff --git a/gcc/ada/libgnat/s-parame__vxworks.adb b/gcc/ada/libgnat/s-parame__vxworks.adb index 97d74b6..325aa2e 100644 --- a/gcc/ada/libgnat/s-parame__vxworks.adb +++ b/gcc/ada/libgnat/s-parame__vxworks.adb @@ -48,18 +48,6 @@ package body System.Parameters is end if; end Adjust_Storage_Size; - ---------------------------- - -- Default_Sec_Stack_Size -- - ---------------------------- - - function Default_Sec_Stack_Size return Size_Type is - Default_SS_Size : Integer; - pragma Import (C, Default_SS_Size, - "__gnat_default_ss_size"); - begin - return Size_Type (Default_SS_Size); - end Default_Sec_Stack_Size; - ------------------------ -- Default_Stack_Size -- ------------------------ diff --git a/gcc/ada/libgnat/s-parame__vxworks.ads b/gcc/ada/libgnat/s-parame__vxworks.ads index e395e01..ab5a085 100644 --- a/gcc/ada/libgnat/s-parame__vxworks.ads +++ b/gcc/ada/libgnat/s-parame__vxworks.ads @@ -93,10 +93,6 @@ package System.Parameters is -- The run-time chosen default size for secondary stacks that may be -- overriden by the user with the use of binder -D switch. - function Default_Sec_Stack_Size return Size_Type; - -- The default initial size for secondary stacks that reflects any user - -- specified default via the binder -D switch. - Sec_Stack_Dynamic : constant Boolean := True; -- Indicates if secondary stacks can grow and shrink at run-time. If False, -- the size of a secondary stack is fixed at the point of its creation. diff --git a/gcc/ada/libgnat/s-secsta.adb b/gcc/ada/libgnat/s-secsta.adb index b39cf0d..84d6095 100644 --- a/gcc/ada/libgnat/s-secsta.adb +++ b/gcc/ada/libgnat/s-secsta.adb @@ -52,27 +52,40 @@ package body System.Secondary_Stack is (Addr : out Address; Storage_Size : SSE.Storage_Count) is + use type System.Storage_Elements.Storage_Count; + Max_Align : constant SS_Ptr := SS_Ptr (Standard'Maximum_Alignment); - Mem_Request : constant SS_Ptr := - ((SS_Ptr (Storage_Size) + Max_Align - 1) / Max_Align) * - Max_Align; - -- Round up Storage_Size to the nearest multiple of the max alignment - -- value for the target. This ensures efficient stack access. + Mem_Request : SS_Ptr; - Stack : constant SS_Stack_Ptr := SSL.Get_Sec_Stack.all; + Stack : constant SS_Stack_Ptr := SSL.Get_Sec_Stack.all; begin + -- Round up Storage_Size to the nearest multiple of the max alignment + -- value for the target. This ensures efficient stack access. First + -- perform a check to ensure that the rounding operation does not + -- overflow SS_Ptr. + + if SSE.Storage_Count (SS_Ptr'Last) - Standard'Maximum_Alignment < + Storage_Size + then + raise Storage_Error; + end if; + + Mem_Request := ((SS_Ptr (Storage_Size) + Max_Align - 1) / Max_Align) * + Max_Align; + -- Case of fixed secondary stack if not SP.Sec_Stack_Dynamic then -- Check if max stack usage is increasing - if Stack.Top + Mem_Request > Stack.Max then + if Stack.Max - Stack.Top - Mem_Request < 0 then -- If so, check if the stack is exceeded, noting Stack.Top points -- to the first free byte (so the value of Stack.Top on a fully - -- allocated stack will be Stack.Size + 1). + -- allocated stack will be Stack.Size + 1). The comparison is + -- formed to prevent integer overflows. - if Stack.Top + Mem_Request > Stack.Size + 1 then + if Stack.Size - Stack.Top - Mem_Request < -1 then raise Storage_Error; end if; @@ -90,8 +103,8 @@ package body System.Secondary_Stack is else declare - Chunk : Chunk_Ptr; - + Chunk : Chunk_Ptr; + Chunk_Size : SS_Ptr; To_Be_Released_Chunk : Chunk_Ptr; begin @@ -108,9 +121,8 @@ package body System.Secondary_Stack is -- sufficient, if not, go to the next one and eventually create -- the necessary room. - while Chunk.Last - Stack.Top + 1 < Mem_Request loop + while Chunk.Last - Stack.Top - Mem_Request < -1 loop if Chunk.Next /= null then - -- Release unused non-first empty chunk if Chunk.Prev /= null and then Chunk.First = Stack.Top then @@ -121,24 +133,29 @@ package body System.Secondary_Stack is Free (To_Be_Released_Chunk); end if; - -- Create new chunk of default size unless it is not sufficient - -- to satisfy the current request. + -- Create a new chunk - elsif Mem_Request <= Stack.Size then - Chunk.Next := - new Chunk_Id - (First => Chunk.Last + 1, - Last => Chunk.Last + SS_Ptr (Stack.Size)); + else + -- The new chunk should be no smaller than the default + -- chunk size to minimize the amount of secondary stack + -- management. + + if Mem_Request <= Stack.Size then + Chunk_Size := Stack.Size; + else + Chunk_Size := Mem_Request; + end if; - Chunk.Next.Prev := Chunk; + -- Check that the indexing limits are not exceeded - -- Otherwise create new chunk of requested size + if SS_Ptr'Last - Chunk.Last - Chunk_Size < 0 then + raise Storage_Error; + end if; - else Chunk.Next := new Chunk_Id (First => Chunk.Last + 1, - Last => Chunk.Last + Mem_Request); + Last => Chunk.Last + Chunk_Size); Chunk.Next.Prev := Chunk; end if; @@ -267,10 +284,10 @@ package body System.Secondary_Stack is & SS_Ptr'Image (Stack.Top - 1) & " bytes"); - Put_Line (" Number of Chunks : " + Put_Line (" Number of Chunks : " & Integer'Image (Nb_Chunks)); - Put_Line (" Default size of Chunks : " + Put_Line (" Default size of Chunks : " & SP.Size_Type'Image (Stack.Size)); end; end if; @@ -300,7 +317,15 @@ package body System.Secondary_Stack is if Stack = null then if Size = Unspecified_Size then - Stack_Size := Default_Sec_Stack_Size; + -- Cover the case when bootstraping with an old compiler that does + -- not set Default_SS_Size. + + if Default_SS_Size > 0 then + Stack_Size := Default_SS_Size; + else + Stack_Size := Runtime_Default_Sec_Stack_Size; + end if; + else Stack_Size := Size; end if; |