1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147 | ------------------------------------------------------------------------------
-- GNATBENCH --
-- --
-- Copyright (C) 2016, AdaCore --
-- --
-- This 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. This software is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
-- License for more details. You should have received a copy of the GNU --
-- General Public License distributed with this software; see file --
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
-- of the license. --
------------------------------------------------------------------------------
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with System.Address_Image;
with GNATCOLL.Memory;
with Ada.Calendar; use Ada.Calendar;
with Ada.Calendar.Formatting; use Ada.Calendar.Formatting;
with Ada.Calendar.Time_Zones; use Ada.Calendar.Time_Zones;
package body Memory_Statistics is
----------------------------
-- Dump_Memory_Statistics --
----------------------------
function Dump_Memory_Statistics
(Comment : String;
Size : Positive;
Report : Report_Type := All_Reports)
return String
is
procedure Trace_Put (S : String);
procedure Trace_Put_Line (S : String);
Buffer : Unbounded_String := To_Unbounded_String
(Image
(Date => Clock,
Time_Zone => Ada.Calendar.Time_Zones.UTC_Time_Offset) &
" " & Comment & " - Dump_Memory_Statistics at 0x" &
System.Address_Image (Dump_Memory_Statistics'Address) & ASCII.LF);
procedure Trace_Put (S : String) is
begin
Append (Buffer, S);
end Trace_Put;
procedure Trace_Put_Line (S : String) is
begin
Append (Buffer, S & ASCII.LF);
end Trace_Put_Line;
procedure Internal is new GNATCOLL.Memory.Redirectable_Dump
(Put_Line => Trace_Put_Line,
Put => Trace_Put);
begin
case Report is
when Memory_Usage =>
Internal (Size, GNATCOLL.Memory.Memory_Usage);
when Allocations_Count =>
Internal (Size, GNATCOLL.Memory.Allocations_Count);
when Sort_Total_Allocs =>
Internal (Size, GNATCOLL.Memory.Sort_Total_Allocs);
when Marked_Blocks =>
Internal (Size, GNATCOLL.Memory.Marked_Blocks);
when others =>
Internal (Size);
end case;
return To_String (Buffer);
end Dump_Memory_Statistics;
---------------
-- Configure --
---------------
procedure Configure
(Activate_Monitor : Boolean := False;
Disable_Free : Boolean := False;
Stack_Trace_Depth : Natural := 30;
Maximum_Logically_Freed_Memory : Long_Long_Integer := 50_000_000;
Minimum_To_Free : Long_Long_Integer := 0;
Reset_Content_On_Free : Boolean := True;
Raise_Exceptions : Boolean := False;
Advanced_Scanning : Boolean := False;
Errors_To_Stdout : Boolean := True;
Low_Level_Traces : Boolean := False) is
begin
GNATCOLL.Memory.Configure
(Activate_Monitor => Activate_Monitor,
Disable_Free => Disable_Free,
Stack_Trace_Depth => Stack_Trace_Depth,
Maximum_Logically_Freed_Memory => Maximum_Logically_Freed_Memory,
Minimum_To_Free => Minimum_To_Free,
Reset_Content_On_Free => Reset_Content_On_Free,
Raise_Exceptions => Raise_Exceptions,
Advanced_Scanning => Advanced_Scanning,
Errors_To_Stdout => Errors_To_Stdout,
Low_Level_Traces => Low_Level_Traces);
end Configure;
-----------
-- Reset --
-----------
procedure Reset is
begin
GNATCOLL.Memory.Reset;
end Reset;
-------------------------
-- Get_Ada_Allocations --
-------------------------
function Get_Ada_Allocations return Watermark_Info is
Ada_Allocations : constant GNATCOLL.Memory.Watermark_Info :=
GNATCOLL.Memory.Get_Ada_Allocations;
begin
return
(High => Byte_Count (Ada_Allocations.High),
Current => Byte_Count (Ada_Allocations.Current)
);
end Get_Ada_Allocations;
---------------------
-- Get_Allocations --
---------------------
function Get_Allocations return Watermark_Info is
function Get_Peak_RSS return GNATCOLL.Memory.size_t;
pragma Import (C, Get_Peak_RSS, "gnatcoll_getPeakRSS");
function Get_Current_RSS return GNATCOLL.Memory.size_t;
pragma Import (C, Get_Current_RSS, "gnatcoll_getCurrentRSS");
begin
return (High => Byte_Count (Get_Peak_RSS),
Current => Byte_Count (Get_Current_RSS));
end Get_Allocations;
end Memory_Statistics;
|