diff options
-rw-r--r-- | src/dyn_tables.adb | 40 | ||||
-rw-r--r-- | src/dyn_tables.ads | 9 | ||||
-rw-r--r-- | src/tables.adb | 4 |
3 files changed, 40 insertions, 13 deletions
diff --git a/src/dyn_tables.adb b/src/dyn_tables.adb index be733acc8..9af097702 100644 --- a/src/dyn_tables.adb +++ b/src/dyn_tables.adb @@ -26,18 +26,25 @@ package body Dyn_Tables is -- Expand the table by doubling its size. The table must have been -- initialized. - procedure Expand (T : in out Instance; Num : Natural) + procedure Expand (T : in out Instance; Num : Unsigned) is -- For efficiency, directly call realloc. function Crealloc (Ptr : Table_Thin_Ptr; Size : size_t) return Table_Thin_Ptr; pragma Import (C, Crealloc, "realloc"); + + New_Len : Unsigned; + New_Last : Unsigned; begin pragma Assert (T.Priv.Length /= 0); pragma Assert (T.Table /= null); -- Expand the bound. - T.Priv.Last_Pos := T.Priv.Last_Pos + Num; + New_Last := T.Priv.Last_Pos + Num; + if New_Last < T.Priv.Last_Pos then + raise Constraint_Error; + end if; + T.Priv.Last_Pos := New_Last; -- Check if need to reallocate. if T.Priv.Last_Pos < T.Priv.Length then @@ -45,12 +52,22 @@ package body Dyn_Tables is else -- Double the length. loop - T.Priv.Length := T.Priv.Length * 2; - exit when T.Priv.Length > T.Priv.Last_Pos; + New_Len := T.Priv.Length * 2; + + -- Check overflow. + if New_Len < T.Priv.Length then + raise Constraint_Error; + end if; + + T.Priv.Length := New_Len; + exit when New_Len > T.Priv.Last_Pos; end loop; end if; -- Realloc and check result. + if size_t (T.Priv.Length) > size_t'Last / El_Size then + raise Constraint_Error; + end if; T.Table := Crealloc (T.Table, size_t (T.Priv.Length) * El_Size); if T.Table = null then raise Storage_Error; @@ -59,7 +76,7 @@ package body Dyn_Tables is procedure Allocate (T : in out Instance; Num : Natural := 1) is begin - Expand (T, Num); + Expand (T, Unsigned (Num)); end Allocate; procedure Increment_Last (T : in out Instance) is @@ -75,7 +92,7 @@ package body Dyn_Tables is procedure Set_Last (T : in out Instance; Index : Table_Index_Type) is - New_Last : constant Natural := + New_Last : constant Unsigned := (Table_Index_Type'Pos (Index) - Table_Index_Type'Pos (Table_Low_Bound) + 1); begin @@ -96,7 +113,7 @@ package body Dyn_Tables is begin if T.Table = null then -- Allocate memory if not already allocated. - T.Priv.Length := Table_Initial; + T.Priv.Length := Unsigned (Table_Initial); T.Table := Cmalloc (size_t (T.Priv.Length) * El_Size); end if; @@ -107,9 +124,16 @@ package body Dyn_Tables is function Last (T : Instance) return Table_Index_Type is begin return Table_Index_Type'Val - (Table_Index_Type'Pos (Table_Low_Bound) + T.Priv.Last_Pos - 1); + (Table_Index_Type'Pos (Table_Low_Bound) + + Unsigned'Pos (T.Priv.Last_Pos) - 1); end Last; + function Next (T : Instance) return Table_Index_Type is + begin + return Table_Index_Type'Val + (Table_Index_Type'Pos (Table_Low_Bound) + T.Priv.Last_Pos); + end Next; + procedure Free (T : in out Instance) is -- Direct interface to free. procedure Cfree (Ptr : Table_Thin_Ptr); diff --git a/src/dyn_tables.ads b/src/dyn_tables.ads index 600e2bf85..f1cffac84 100644 --- a/src/dyn_tables.ads +++ b/src/dyn_tables.ads @@ -71,6 +71,9 @@ package Dyn_Tables is function Last (T : Instance) return Table_Index_Type; pragma Inline (Last); + -- Return the index of the next bound after last. + function Next (T : Instance) return Table_Index_Type; + -- Deallocate all the memory. Makes the array unusable until the next -- call to Init. procedure Free (T : in out Instance); @@ -95,11 +98,13 @@ package Dyn_Tables is procedure Allocate (T : in out Instance; Num : Natural := 1); private + type Unsigned is mod 2**32; + type Instance_Private is record -- Number of allocated elements in the table. - Length : Natural := 0; + Length : Unsigned := 0; -- Number of used elements in the table. - Last_Pos : Natural := 0; + Last_Pos : Unsigned := 0; end record; end Dyn_Tables; diff --git a/src/tables.adb b/src/tables.adb index ef4cc385a..3b8a888b8 100644 --- a/src/tables.adb +++ b/src/tables.adb @@ -19,8 +19,7 @@ package body Tables is function Allocate (Num : Natural := 1) return Table_Index_Type is - Res : constant Table_Index_Type := Table_Index_Type'Val - (Table_Index_Type'Pos (Last) + 1); + Res : constant Table_Index_Type := Dyn_Table.Next (T); begin Dyn_Table.Allocate (T, Num); @@ -62,7 +61,6 @@ package body Tables is begin Dyn_Table.Append (T, Val); end Append; - begin Init; end Tables; |