2004-03-25 Vasiliy Fofanov <fofanov@act-europe.fr>

	* memtrack.adb: Log realloc calls, which are treated as free followed
	by alloc.

2004-03-25  Vincent Celier  <celier@gnat.com>

	* prj-makr.adb (Process_Directories): Detect when a file contains
	several units. Do not include such files in the config pragmas or
	in the naming scheme.

	* prj-nmsc.adb (Record_Source): New parameter Trusted_Mode.
	Resolve links only when not in Trusted_Mode.
	(Find_Sources, Recursive_Find_Dirs, Find_Source_Dirs, Locate_Directory):
	Do not resolve links for the display names.

	* prj-part.adb (Parse_Single_Project, Project_Path_Name_Of): Do not
	resolve links when computing the display names.

2004-03-25  Thomas Quinot  <quinot@act-europe.fr>

	* sem_attr.adb (Check_Dereference): When the prefix of a 'Tag
	attribute reference does not denote a subtype, it can be any
	expression that has a classwide type, potentially after an implicit
	dereference.  In particular, the prefix can be a view conversion for
	a classwide type (for which Is_Object_Reference holds), but it can
	also be a value conversion for an access-to-classwide type. In the
	latter case, there is an implicit dereference, and the original node
	for the prefix does not verify Is_Object_Reference.

	* sem_util.adb (Is_Dependent_Component_Of_Mutable_Object): A view
	conversion of a discriminant-dependent component of a mutable object
	is one itself.

2004-03-25  Ed Schonberg  <schonberg@gnat.com>

	* freeze.adb (Freeze_Entity): When an inherited subprogram is
	inherited, has convention C, and has unconstrained array parameters,
	place the corresponding warning on the derived type declaration rather
	than the original subprogram.

	* sem_ch12.adb (Instantiate_Formal_Subprogram): Set From_Default
	indication on renaming declaration, if formal has a box and actual
	is absent.

	* sem_ch8.adb (Analyze_Subprogram_Renaming): Use From_Default flag to
	determine whether to generate an implicit or explicit reference to
	the renamed entity.

	* sinfo.ads, sinfo.adb: New flag From_Default, to indicate that a
	subprogram renaming comes from a defaulted formal subprogram in an
	instance.

2004-03-25  Gary Dismukes  <dismukes@gnat.com>

	* sem_elab.adb (Check_Elab_Call): Refine loop that checks for default
	value expressions to ensure that calls within a component definition
	will be checked (since those are evaluated during the record type's
	elaboration).

2004-03-25  Arnaud Charlet  <charlet@act-europe.fr>

	* s-tpobop.adb: Code clean up:
	(Requeue_Call): Extract from PO_Service_Entries to remove duplicated
	code.
	(PO_Do_Or_Queue): Remove duplicated code and use Requeue_Call.

2004-03-25  Jose Ruiz  <ruiz@act-europe.fr>

	* Makefile.in: Clean up in the ravenscar run time.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@79953 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 55 insertions, 2 deletions

diff --git a/gcc/ada/memtrack.adb b/gcc/ada/memtrack.adb
index 2531702cb7b..39ffb82eafb 100644
--- a/gcc/ada/memtrack.adb
+++ b/gcc/ada/memtrack.adb
@@ -297,15 +297,68 @@ package body System.Memory is
    function Realloc
      (Ptr : System.Address; Size : size_t) return System.Address
    is
-      Result : System.Address;
+      Addr : aliased constant System.Address := Ptr;
+      Result : aliased System.Address;
 
    begin
+      --  For the purposes of allocations logging, we treat realloc as a free
+      --  followed by malloc. This is not exactly accurate, but is a good way
+      --  to fit it into malloc/free-centered reports.
+
       if Size = size_t'Last then
          Raise_Exception (Storage_Error'Identity, "object too large");
       end if;
 
       Abort_Defer.all;
-      Result := c_realloc (Ptr, Size);
+      Lock_Task.all;
+
+      if First_Call then
+
+         First_Call := False;
+
+         --  We first log deallocation call
+
+         Gmem_Initialize;
+         Call_Chain (Tracebk'Address, Max_Call_Stack, Num_Calls,
+                     Skip_Frames => 2);
+         fputc (Character'Pos ('D'), Gmemfile);
+         fwrite (Addr'Address, Address_Size, 1, Gmemfile);
+         fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1,
+                 Gmemfile);
+
+         for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop
+            declare
+               Ptr : System.Address := PC_For (Tracebk (J));
+            begin
+               fwrite (Ptr'Address, Address_Size, 1, Gmemfile);
+            end;
+         end loop;
+
+         --  Now perform actual realloc
+
+         Result := c_realloc (Ptr, Size);
+
+         --   Log allocation call using the same backtrace
+
+         fputc (Character'Pos ('A'), Gmemfile);
+         fwrite (Result'Address, Address_Size, 1, Gmemfile);
+         fwrite (Size'Address, size_t'Max_Size_In_Storage_Elements, 1,
+                 Gmemfile);
+         fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1,
+                 Gmemfile);
+
+         for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop
+            declare
+               Ptr : System.Address := PC_For (Tracebk (J));
+            begin
+               fwrite (Ptr'Address, Address_Size, 1, Gmemfile);
+            end;
+         end loop;
+
+         First_Call := True;
+      end if;
+
+      Unlock_Task.all;
       Abort_Undefer.all;
 
       if Result = System.Null_Address then