From c343f1dc19cd16e0fb995c2d3c27c13ab27e0a26 Mon Sep 17 00:00:00 2001 From: Patrick Bernardi Date: Tue, 17 Jul 2018 08:11:37 +0000 Subject: [PATCH] [Ada] Use standard version of s-memory.adb for mingw32 This patch switches mingw32 targets to use the standard version of s-memory.adb as Windows now has the capability of limiting the amount of memory used by process. 2018-07-17 Patrick Bernardi gcc/ada/ * libgnat/s-memory__mingw.adb: Remove. * Makefile.rtl: Remove s-memory.adb target pair from the Cygwin/Mingw32 section. gcc/testsuite/ * gnat.dg/memorytest.adb: New testcase. From-SVN: r262796 --- gcc/ada/ChangeLog | 6 + gcc/ada/Makefile.rtl | 12 +- gcc/ada/libgnat/s-memory__mingw.adb | 221 --------------------------- gcc/testsuite/ChangeLog | 4 + gcc/testsuite/gnat.dg/memorytest.adb | 26 ++++ 5 files changed, 41 insertions(+), 228 deletions(-) delete mode 100644 gcc/ada/libgnat/s-memory__mingw.adb create mode 100644 gcc/testsuite/gnat.dg/memorytest.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1b8da215bea..285d7e435fc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2018-07-17 Patrick Bernardi + + * libgnat/s-memory__mingw.adb: Remove. + * Makefile.rtl: Remove s-memory.adb target pair from the Cygwin/Mingw32 + section. + 2018-07-17 Hristian Kirtchev * frontend.adb (Frontend): The removal of ignored Ghost code must be diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 374c60b576e..7eaa9ba90cd 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -1960,19 +1960,17 @@ endif # Cygwin/Mingw32 ifeq ($(strip $(filter-out cygwin% mingw32% pe,$(target_os))),) # Cygwin provides a full Posix environment, and so we use the default - # versions of s-memory and g-socthi rather than the Windows-specific - # MinGW versions. Ideally we would use all the default versions for - # Cygwin and none of the MinGW versions, but for historical reasons - # the Cygwin port has always been a CygMing frankenhybrid and it is - # a long-term project to disentangle them. + # versions g-socthi rather than the Windows-specific MinGW version. + # Ideally we would use all the default versions for Cygwin and none + # of the MinGW versions, but for historical reasons the Cygwin port + # has always been a CygMing frankenhybrid and it is a long-term project + # to disentangle them. ifeq ($(strip $(filter-out cygwin%,$(target_os))),) LIBGNAT_TARGET_PAIRS = \ - s-memory.adb. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This version provides ways to limit the amount of used memory for systems --- that do not have OS support for that. - --- The amount of available memory available for dynamic allocation is limited --- by setting the environment variable GNAT_MEMORY_LIMIT to the number of --- kilobytes that can be used. --- --- Windows is currently using this version. - -with Ada.Exceptions; -with System.Soft_Links; - -package body System.Memory is - - use Ada.Exceptions; - use System.Soft_Links; - - function c_malloc (Size : size_t) return System.Address; - pragma Import (C, c_malloc, "malloc"); - - procedure c_free (Ptr : System.Address); - pragma Import (C, c_free, "free"); - - function c_realloc - (Ptr : System.Address; Size : size_t) return System.Address; - pragma Import (C, c_realloc, "realloc"); - - function msize (Ptr : System.Address) return size_t; - pragma Import (C, msize, "_msize"); - - function getenv (Str : String) return System.Address; - pragma Import (C, getenv); - - function atoi (Str : System.Address) return Integer; - pragma Import (C, atoi); - - Available_Memory : size_t := 0; - -- Amount of memory that is available for heap allocations. - -- A value of 0 means that the amount is not yet initialized. - - Msize_Accuracy : constant := 4096; - -- Defines the amount of memory to add to requested allocation sizes, - -- because malloc may return a bigger block than requested. As msize - -- is used when by Free, it must be used on allocation as well. To - -- prevent underflow of available_memory we need to use a reserve. - - procedure Check_Available_Memory (Size : size_t); - -- This routine must be called while holding the task lock. When the - -- memory limit is not yet initialized, it will be set to the value of - -- the GNAT_MEMORY_LIMIT environment variable or to unlimited if that - -- does not exist. If the size is larger than the amount of available - -- memory, the task lock will be freed and a storage_error exception - -- will be raised. - - ----------- - -- Alloc -- - ----------- - - function Alloc (Size : size_t) return System.Address is - Result : System.Address; - Actual_Size : size_t := Size; - - begin - if Size = size_t'Last then - Raise_Exception (Storage_Error'Identity, "object too large"); - end if; - - -- Change size from zero to non-zero. We still want a proper pointer - -- for the zero case because pointers to zero length objects have to - -- be distinct, but we can't just go ahead and allocate zero bytes, - -- since some malloc's return zero for a zero argument. - - if Size = 0 then - Actual_Size := 1; - end if; - - Lock_Task.all; - - if Actual_Size + Msize_Accuracy >= Available_Memory then - Check_Available_Memory (Size + Msize_Accuracy); - end if; - - Result := c_malloc (Actual_Size); - - if Result /= System.Null_Address then - Available_Memory := Available_Memory - msize (Result); - end if; - - Unlock_Task.all; - - if Result = System.Null_Address then - Raise_Exception (Storage_Error'Identity, "heap exhausted"); - end if; - - return Result; - end Alloc; - - ---------------------------- - -- Check_Available_Memory -- - ---------------------------- - - procedure Check_Available_Memory (Size : size_t) is - Gnat_Memory_Limit : System.Address; - - begin - if Available_Memory = 0 then - - -- The amount of available memory hasn't been initialized yet - - Gnat_Memory_Limit := getenv ("GNAT_MEMORY_LIMIT" & ASCII.NUL); - - if Gnat_Memory_Limit /= System.Null_Address then - Available_Memory := - size_t (atoi (Gnat_Memory_Limit)) * 1024 + Msize_Accuracy; - else - Available_Memory := size_t'Last; - end if; - end if; - - if Size >= Available_Memory then - - -- There is a memory overflow - - Unlock_Task.all; - Raise_Exception - (Storage_Error'Identity, "heap memory limit exceeded"); - end if; - end Check_Available_Memory; - - ---------- - -- Free -- - ---------- - - procedure Free (Ptr : System.Address) is - begin - Lock_Task.all; - - if Ptr /= System.Null_Address then - Available_Memory := Available_Memory + msize (Ptr); - end if; - - c_free (Ptr); - - Unlock_Task.all; - end Free; - - ------------- - -- Realloc -- - ------------- - - function Realloc - (Ptr : System.Address; - Size : size_t) - return System.Address - is - Result : System.Address; - Actual_Size : constant size_t := Size; - Old_Size : size_t; - - begin - if Size = size_t'Last then - Raise_Exception (Storage_Error'Identity, "object too large"); - end if; - - Lock_Task.all; - - Old_Size := msize (Ptr); - - -- Conservative check - no need to try to be precise here - - if Size + Msize_Accuracy >= Available_Memory then - Check_Available_Memory (Size + Msize_Accuracy); - end if; - - Result := c_realloc (Ptr, Actual_Size); - - if Result /= System.Null_Address then - Available_Memory := Available_Memory + Old_Size - msize (Result); - end if; - - Unlock_Task.all; - - if Result = System.Null_Address then - Raise_Exception (Storage_Error'Identity, "heap exhausted"); - end if; - - return Result; - end Realloc; - -end System.Memory; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 50cc08f4a95..7c4189e84c8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-07-17 Patrick Bernardi + + * gnat.dg/memorytest.adb: New testcase. + 2018-07-17 Hristian Kirtchev * gnat.dg/config_pragma1.adb, gnat.dg/config_pragma1_pkg.ads: New testcase. diff --git a/gcc/testsuite/gnat.dg/memorytest.adb b/gcc/testsuite/gnat.dg/memorytest.adb new file mode 100644 index 00000000000..ffc33864e65 --- /dev/null +++ b/gcc/testsuite/gnat.dg/memorytest.adb @@ -0,0 +1,26 @@ +-- { dg-do run } + +with Interfaces.C; use Interfaces.C; +with Interfaces.C.Strings; use Interfaces.C.Strings; +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; + +procedure memorytest is + + function malloc (size: size_t) return chars_ptr; + pragma Import (C, malloc); + + C : chars_ptr; + +begin + -- Allocate a string in C ... + C := malloc (1000); + -- ... and free it with the GNAT runtime + Free (C); + + -- now allocate something completely unrelated and free it + declare + A2 : Unbounded_String := To_Unbounded_String ("hello"); + begin + null; + end; +end; -- 2.30.2