aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/g-debpoo.adb
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2004-04-21 12:10:33 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2004-04-21 12:10:33 +0200
commitaf4b94345e257e98a61127d9ea9624ff4dabc714 (patch)
treecb483e73b8234a7c09313d872880ca8992c5d9e3 /gcc/ada/g-debpoo.adb
parent0a7460199f1c204bf6b165fc8d29bfc5a5c8b0bf (diff)
downloadgcc-af4b94345e257e98a61127d9ea9624ff4dabc714.zip
gcc-af4b94345e257e98a61127d9ea9624ff4dabc714.tar.gz
gcc-af4b94345e257e98a61127d9ea9624ff4dabc714.tar.bz2
[multiple changes]
2004-04-21 Pascal Obry <obry@gnat.com> * adaint.c (__gnat_portable_spawn): Quote first argument (argv[0]) passed to spawnvp() to properly handle program pathname with spaces on Win32. 2004-04-21 Emmanuel Briot <briot@act-europe.fr> * g-debpoo.adb (Print_Info): Avoid extra work if Display_Slots is False. (Allocate, Deallocate, Free_Physically): Make sure the tasks are unlocked in case of exceptions. 2004-04-21 Joel Brobecker <brobecker@gnat.com> * gigi.h (get_target_no_dollar_in_label): Remove extern declaration. This function does not exist anymore. 2004-04-21 Thomas Quinot <quinot@act-europe.fr> * gnatbind.adb, gnatlink.adb: Update name of imported C symbol. * link.c: Move variables to the __gnat name space. * Makefile.in: list link.o explicitly when needed. * mlib.adb: Remove pragma Linker_Option for "link.o" from mlib. 2004-04-21 Javier Miranda <miranda@gnat.com> * einfo.adb (Original_Access_Type): New subprogram (Set_Original_Access_Type): New subprogram (Write_Field21_Name): Write the name of the new field * einfo.ads (Original_Access_Type): New field present in access to subprogram types. Addition of two new entities: E_Anonymous_Access_Subprogram_Type, and E_Anonymous_Access_Protected_Subprogram_Type. * lib-xref.adb (Output_One_Ref): Give support to anonymous access to subprogram types. * lib-xref.ads (Xref_Entity_Letters): Initialize values corresponding to anonymous access to subprogram types. * sem_attr.adb (Resolve_Attribute): Give support to anonymous access to subprogram types. * sem_ch3.adb (Access_Definition): Complete decoration of entities corresponding to anonymous access to subprogram types. (Analyze_Component_Declaration): Add new actual to the call to subprogram replace_anonymous_access_to_protected_subprogram. (Array_Type_Declaration): Add new actual to the call to subprogram replace_anonymous_access_to_protected_subprogram. (Process_Discriminants): Add new actual to the call to subprogram replace_anonymous_access_to_protected_subprogram. (Replace_Anonymous_Access_To_Protected_Subprogram): New formal. * sem_ch3.ads (Replace_Anonymous_Access_To_Protected_Subprogram): New formal. * sem_ch6.adb, sem_type.adb, sem_res.adb: Give support to anonymous access to subprogram types. * sem_util.adb (Has_Declarations): Addition of package_specification nodes. 2004-04-21 Ed Schonberg <schonberg@gnat.com> * sem_prag.adb (Make_Inline): If subprogram is a renaming, propagate inlined flags to renamed entity only if in current unit. 2004-04-21 Thomas Quinot <quinot@act-europe.fr> * s-parint.ads: Add DSA implementation marker. * rtsfind.ads, rtsfind.adb, snames.ads, snames.adb, s-rpc.adb: Use the value of System.Partition_Interface.DSA_Implementation to determine what version of the distributed systems annex is available (no implementation, GLADE, or PolyORB). 2004-04-21 Joel Brobecker <brobecker@gnat.com> * targtyps.c (get_target_no_dollar_in_label): Remove, no longer used. 2004-04-21 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> * utils.c (convert, case CONSTRUCTOR, COMPONENT_REF): Do not make node with new type if alias sets differ. Fixes ACATS c41103b. 2004-04-21 Vincent Celier <celier@gnat.com> * prj.ads: Remove FORTRAN as an accepted language: not tested yet. Add array Lang_Args for the language specific compiling argument switches. * gnat_ugn.texi: Explain in more details when a library is rebuilt. 2004-04-21 Sergey Rybin <rybin@act-europe.fr> * gnat_rm.texi: Update the descripton of the Eliminate pragma according to the recent changes in the format of the parameters of the pragma (replacing Homonym_Number with Source_Location). From-SVN: r80956
Diffstat (limited to 'gcc/ada/g-debpoo.adb')
-rw-r--r--gcc/ada/g-debpoo.adb127
1 files changed, 71 insertions, 56 deletions
diff --git a/gcc/ada/g-debpoo.adb b/gcc/ada/g-debpoo.adb
index 4eeae1a..4d93310 100644
--- a/gcc/ada/g-debpoo.adb
+++ b/gcc/ada/g-debpoo.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -769,6 +769,11 @@ package body GNAT.Debug_Pools is
end if;
Unlock_Task.all;
+
+ exception
+ when others =>
+ Unlock_Task.all;
+ raise;
end Allocate;
------------------
@@ -1056,6 +1061,11 @@ package body GNAT.Debug_Pools is
end if;
Unlock_Task.all;
+
+ exception
+ when others =>
+ Unlock_Task.all;
+ raise;
end Free_Physically;
----------------
@@ -1166,6 +1176,11 @@ package body GNAT.Debug_Pools is
Unlock_Task.all;
end if;
+
+ exception
+ when others =>
+ Unlock_Task.all;
+ raise;
end Deallocate;
--------------------
@@ -1310,71 +1325,71 @@ package body GNAT.Debug_Pools is
Put_Line ("");
- Data := Backtrace_Htable.Get_First;
- while Data /= null loop
- if Data.Kind in Alloc .. Dealloc then
- Elem :=
- new Traceback_Htable_Elem'
- (Traceback => new Tracebacks_Array'(Data.Traceback.all),
- Count => Data.Count,
- Kind => Data.Kind,
- Total => Data.Total,
- Next => null);
- Backtrace_Htable_Cumulate.Set (Elem);
-
- if Cumulate then
- if Data.Kind = Alloc then
- K := Indirect_Alloc;
- else
- K := Indirect_Dealloc;
- end if;
+ if Display_Slots then
+ Data := Backtrace_Htable.Get_First;
+ while Data /= null loop
+ if Data.Kind in Alloc .. Dealloc then
+ Elem :=
+ new Traceback_Htable_Elem'
+ (Traceback => new Tracebacks_Array'(Data.Traceback.all),
+ Count => Data.Count,
+ Kind => Data.Kind,
+ Total => Data.Total,
+ Next => null);
+ Backtrace_Htable_Cumulate.Set (Elem);
+
+ if Cumulate then
+ if Data.Kind = Alloc then
+ K := Indirect_Alloc;
+ else
+ K := Indirect_Dealloc;
+ end if;
- -- Propagate the direct call to all its parents
+ -- Propagate the direct call to all its parents
- for T in Data.Traceback'First + 1 .. Data.Traceback'Last loop
- Elem := Backtrace_Htable_Cumulate.Get
- (Data.Traceback
- (T .. Data.Traceback'Last)'Unrestricted_Access);
+ for T in Data.Traceback'First + 1 .. Data.Traceback'Last loop
+ Elem := Backtrace_Htable_Cumulate.Get
+ (Data.Traceback
+ (T .. Data.Traceback'Last)'Unrestricted_Access);
- -- If not, insert it
+ -- If not, insert it
- if Elem = null then
- Elem := new Traceback_Htable_Elem'
- (Traceback => new Tracebacks_Array'
- (Data.Traceback (T .. Data.Traceback'Last)),
- Count => Data.Count,
- Kind => K,
- Total => Data.Total,
- Next => null);
- Backtrace_Htable_Cumulate.Set (Elem);
+ if Elem = null then
+ Elem := new Traceback_Htable_Elem'
+ (Traceback => new Tracebacks_Array'
+ (Data.Traceback (T .. Data.Traceback'Last)),
+ Count => Data.Count,
+ Kind => K,
+ Total => Data.Total,
+ Next => null);
+ Backtrace_Htable_Cumulate.Set (Elem);
- -- Properly take into account that the subprograms
- -- indirectly called might be doing either allocations
- -- or deallocations. This needs to be reflected in the
- -- counts.
+ -- Properly take into account that the subprograms
+ -- indirectly called might be doing either allocations
+ -- or deallocations. This needs to be reflected in the
+ -- counts.
- else
- Elem.Count := Elem.Count + Data.Count;
+ else
+ Elem.Count := Elem.Count + Data.Count;
- if K = Elem.Kind then
- Elem.Total := Elem.Total + Data.Total;
+ if K = Elem.Kind then
+ Elem.Total := Elem.Total + Data.Total;
- elsif Elem.Total > Data.Total then
- Elem.Total := Elem.Total - Data.Total;
+ elsif Elem.Total > Data.Total then
+ Elem.Total := Elem.Total - Data.Total;
- else
- Elem.Kind := K;
- Elem.Total := Data.Total - Elem.Total;
+ else
+ Elem.Kind := K;
+ Elem.Total := Data.Total - Elem.Total;
+ end if;
end if;
- end if;
- end loop;
- end if;
+ end loop;
+ end if;
- Data := Backtrace_Htable.Get_Next;
- end if;
- end loop;
+ Data := Backtrace_Htable.Get_Next;
+ end if;
+ end loop;
- if Display_Slots then
Put_Line ("List of allocations/deallocations: ");
Data := Backtrace_Htable_Cumulate.Get_First;
@@ -1397,6 +1412,8 @@ package body GNAT.Debug_Pools is
Data := Backtrace_Htable_Cumulate.Get_Next;
end loop;
+
+ Backtrace_Htable_Cumulate.Reset;
end if;
if Display_Leaks then
@@ -1421,8 +1438,6 @@ package body GNAT.Debug_Pools is
Current := Header.Next;
end loop;
end if;
-
- Backtrace_Htable_Cumulate.Reset;
end Print_Info;
------------------