1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                       G N A T . D E B U G _ P O O L S                    --
6--                                                                          --
7--                                 S p e c                                  --
8--                                                                          --
9--          Copyright (C) 1992-2019, Free Software Foundation, Inc.         --
10--                                                                          --
11-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12-- terms of the  GNU General Public License as published  by the Free Soft- --
13-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17--                                                                          --
18-- As a special exception under Section 7 of GPL version 3, you are granted --
19-- additional permissions described in the GCC Runtime Library Exception,   --
20-- version 3.1, as published by the Free Software Foundation.               --
21--                                                                          --
22-- You should have received a copy of the GNU General Public License and    --
23-- a copy of the GCC Runtime Library Exception along with this program;     --
24-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25-- <http://www.gnu.org/licenses/>.                                          --
26--                                                                          --
27-- GNAT was originally developed  by the GNAT team at  New York University. --
28-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29--                                                                          --
30------------------------------------------------------------------------------
31
32--  This packages provides a special implementation of the Ada 95 storage pools
33
34--  The goal of this debug pool is to detect incorrect uses of memory
35--  (multiple deallocations, access to invalid memory,...). Errors are reported
36--  in one of two ways: either by immediately raising an exception, or by
37--  printing a message on standard output or standard error.
38
39--  You need to instrument your code to use this package: for each access type
40--  you want to monitor, you need to add a clause similar to:
41
42--      type Integer_Access is access Integer;
43--      for Integer_Access'Storage_Pool use Pool;
44
45--  where Pool is a tagged object declared with
46--
47--      Pool : GNAT.Debug_Pools.Debug_Pool;
48
49--  This package was designed to be as efficient as possible, but still has an
50--  impact on the performance of your code, which depends on the number of
51--  allocations, deallocations and, somewhat less, dereferences that your
52--  application performs.
53
54--  For each faulty memory use, this debug pool will print several lines
55--  of information, including things like the location where the memory
56--  was initially allocated, the location where it was freed etc.
57
58--  Physical allocations and deallocations are done through the usual system
59--  calls. However, in order to provide proper checks, the debug pool will not
60--  release the memory immediately. It keeps released memory around (the amount
61--  kept around is configurable) so that it can distinguish between memory that
62--  has not been allocated and memory that has been allocated but freed. This
63--  also means that this memory cannot be reallocated, preventing what would
64--  otherwise be a false indication that freed memory is now allocated.
65
66--  In addition, this package presents several subprograms that help analyze
67--  the behavior of your program, by reporting memory leaks, the total amount
68--  of memory that was allocated. The pool is also designed to work correctly
69--  in conjunction with gnatmem.
70
71--  Finally, a subprogram Print_Pool is provided for use from the debugger
72
73--  Limitations
74--  ===========
75
76--  Current limitation of this debug pool: if you use this debug pool for a
77--  general access type ("access all"), the pool might report invalid
78--  dereferences if the access object is pointing to another object on the
79--  stack which was not allocated through a call to "new".
80
81--  This debug pool will respect all alignments specified in your code, but
82--  it does that by aligning all objects using Standard'Maximum_Alignment.
83--  This allows faster checks, and limits the performance impact of using
84--  this pool.
85
86with System;                  use System;
87with System.Storage_Elements; use System.Storage_Elements;
88with System.Checked_Pools;
89
90package GNAT.Debug_Pools is
91
92   type Debug_Pool is new System.Checked_Pools.Checked_Pool with private;
93   --  The new debug pool
94
95   subtype SSC is System.Storage_Elements.Storage_Count;
96
97   Default_Max_Freed         : constant SSC     := 50_000_000;
98   Default_Stack_Trace_Depth : constant Natural := 20;
99   Default_Reset_Content     : constant Boolean := False;
100   Default_Raise_Exceptions  : constant Boolean := True;
101   Default_Advanced_Scanning : constant Boolean := False;
102   Default_Min_Freed         : constant SSC     := 0;
103   Default_Errors_To_Stdout  : constant Boolean := True;
104   Default_Low_Level_Traces  : constant Boolean := False;
105   --  The above values are constants used for the parameters to Configure
106   --  if not overridden in the call. See description of Configure for full
107   --  details on these parameters. If these defaults are not satisfactory,
108   --  then you need to call Configure to change the default values.
109
110   procedure Configure
111     (Pool                           : in out Debug_Pool;
112      Stack_Trace_Depth              : Natural := Default_Stack_Trace_Depth;
113      Maximum_Logically_Freed_Memory : SSC     := Default_Max_Freed;
114      Minimum_To_Free                : SSC     := Default_Min_Freed;
115      Reset_Content_On_Free          : Boolean := Default_Reset_Content;
116      Raise_Exceptions               : Boolean := Default_Raise_Exceptions;
117      Advanced_Scanning              : Boolean := Default_Advanced_Scanning;
118      Errors_To_Stdout               : Boolean := Default_Errors_To_Stdout;
119      Low_Level_Traces               : Boolean := Default_Low_Level_Traces);
120   --  Subprogram used to configure the debug pool.
121   --
122   --    Stack_Trace_Depth. This parameter controls the maximum depth of stack
123   --    traces that are output to indicate locations of actions for error
124   --    conditions such as bad allocations. If set to zero, the debug pool
125   --    will not try to compute backtraces. This is more efficient but gives
126   --    less information on problem locations
127   --
128   --    Maximum_Logically_Freed_Memory: maximum amount of memory (bytes)
129   --    that should be kept before starting to physically deallocate some.
130   --    This value should be non-zero, since having memory that is logically
131   --    but not physically freed helps to detect invalid memory accesses.
132   --
133   --    Minimum_To_Free is the minimum amount of memory that should be freed
134   --    every time the pool starts physically releasing memory. The algorithm
135   --    to compute which block should be physically released needs some
136   --    expensive initialization (see Advanced_Scanning below), and this
137   --    parameter can be used to limit the performance impact by ensuring
138   --    that a reasonable amount of memory is freed each time. Even in the
139   --    advanced scanning mode, marked blocks may be released to match this
140   --    Minimum_To_Free parameter.
141   --
142   --    Reset_Content_On_Free: If true, then the contents of the freed memory
143   --    is reset to the pattern 16#DEADBEEF#, following an old IBM convention.
144   --    This helps in detecting invalid memory references from the debugger.
145   --
146   --    Raise_Exceptions: If true, the exceptions below will be raised every
147   --    time an error is detected. If you set this to False, then the action
148   --    is to generate output on standard error or standard output, depending
149   --    on Errors_To_Stdout, noting the errors, but to
150   --    keep running if possible (of course if storage is badly damaged, this
151   --    attempt may fail. This helps to detect more than one error in a run.
152   --
153   --    Advanced_Scanning: If true, the pool will check the contents of all
154   --    allocated blocks before physically releasing memory. Any possible
155   --    reference to a logically free block will prevent its deallocation.
156   --    Note that this algorithm is approximate, and it is recommended
157   --    that you set Minimum_To_Free to a non-zero value to save time.
158   --
159   --    Errors_To_Stdout: Errors messages will be displayed on stdout if
160   --    this parameter is True, or to stderr otherwise.
161   --
162   --    Low_Level_Traces: Traces all allocation and deallocations on the
163   --    stream specified by Errors_To_Stdout. This can be used for
164   --    post-processing by your own application, or to debug the
165   --    debug_pool itself. The output indicates the size of the allocated
166   --    block both as requested by the application and as physically
167   --    allocated to fit the additional information needed by the debug
168   --    pool.
169   --
170   --  All instantiations of this pool use the same internal tables. However,
171   --  they do not store the same amount of information for the tracebacks,
172   --  and they have different counters for maximum logically freed memory.
173
174   Accessing_Not_Allocated_Storage : exception;
175   --  Exception raised if Raise_Exception is True, and an attempt is made
176   --  to access storage that was never allocated.
177
178   Accessing_Deallocated_Storage : exception;
179   --  Exception raised if Raise_Exception is True, and an attempt is made
180   --  to access storage that was allocated but has been deallocated.
181
182   Freeing_Not_Allocated_Storage : exception;
183   --  Exception raised if Raise_Exception is True, and an attempt is made
184   --  to free storage that had not been previously allocated.
185
186   Freeing_Deallocated_Storage : exception;
187   --  Exception raised if Raise_Exception is True, and an attempt is made
188   --  to free storage that had already been freed.
189
190   --  Note on the above exceptions. The distinction between not allocated
191   --  and deallocated storage is not guaranteed to be accurate in the case
192   --  where storage is allocated, and then physically freed. Larger values
193   --  of the parameter Maximum_Logically_Freed_Memory will help to guarantee
194   --  that this distinction is made more accurately.
195
196   generic
197      with procedure Put_Line (S : String) is <>;
198      with procedure Put      (S : String) is <>;
199   procedure Print_Info
200     (Pool          : Debug_Pool;
201      Cumulate      : Boolean := False;
202      Display_Slots : Boolean := False;
203      Display_Leaks : Boolean := False);
204   --  Print out information about the High Water Mark, the current and
205   --  total number of bytes allocated and the total number of bytes
206   --  deallocated.
207   --
208   --  If Display_Slots is true, this subprogram prints a list of all the
209   --  locations in the application that have done at least one allocation or
210   --  deallocation. The result might be used to detect places in the program
211   --  where lots of allocations are taking place. This output is not in any
212   --  defined order.
213   --
214   --  If Cumulate if True, then each stack trace will display the number of
215   --  allocations that were done either directly, or by the subprograms called
216   --  at that location (e.g: if there were two physical allocations at a->b->c
217   --  and a->b->d, then a->b would be reported as performing two allocations).
218   --
219   --  If Display_Leaks is true, then each block that has not been deallocated
220   --  (often called a "memory leak") will be listed, along with the traceback
221   --  showing where it was allocated. Not that no grouping of the blocks is
222   --  done, you should use the Dump_Gnatmem procedure below in conjunction
223   --  with the gnatmem utility.
224
225   procedure Print_Info_Stdout
226     (Pool          : Debug_Pool;
227      Cumulate      : Boolean := False;
228      Display_Slots : Boolean := False;
229      Display_Leaks : Boolean := False);
230   --  Standard instantiation of Print_Info to print on standard_output. More
231   --  convenient to use where this is the intended location, and in particular
232   --  easier to use from the debugger.
233
234   procedure Dump_Gnatmem (Pool : Debug_Pool; File_Name : String);
235   --  Create an external file on the disk, which can be processed by gnatmem
236   --  to display the location of memory leaks.
237   --
238   --  This provides a nicer output that Print_Info above, and groups similar
239   --  stack traces together. This also provides an easy way to save the memory
240   --  status of your program for post-mortem analysis.
241   --
242   --  To use this file, use the following command line:
243   --     gnatmem 5 -i <File_Name> <Executable_Name>
244   --  If you want all the stack traces to be displayed with 5 levels.
245
246   procedure Print_Pool (A : System.Address);
247   pragma Export (C, Print_Pool, "print_pool");
248   --  This subprogram is meant to be used from a debugger. Given an address in
249   --  memory, it will print on standard output the known information about
250   --  this address (provided, of course, the matching pointer is handled by
251   --  the Debug_Pool).
252   --
253   --  The information includes the stacktrace for the allocation or
254   --  deallocation of that memory chunk, its current status (allocated or
255   --  logically freed), etc.
256
257   type Report_Type is
258     (All_Reports,
259      Memory_Usage,
260      Allocations_Count,
261      Sort_Total_Allocs,
262      Marked_Blocks);
263   for Report_Type use
264     (All_Reports       => 0,
265      Memory_Usage      => 1,
266      Allocations_Count => 2,
267      Sort_Total_Allocs => 3,
268      Marked_Blocks     => 4);
269
270   generic
271      with procedure Put_Line (S : String) is <>;
272      with procedure Put      (S : String) is <>;
273   procedure Dump
274     (Pool   : Debug_Pool;
275      Size   : Positive;
276      Report : Report_Type := All_Reports);
277   --  Dump information about memory usage.
278   --  Size is the number of the biggest memory users we want to show. Report
279   --  indicates which sorting order is used in the report.
280
281   procedure Dump_Stdout
282     (Pool   : Debug_Pool;
283      Size   : Positive;
284      Report : Report_Type := All_Reports);
285   --  Standard instantiation of Dump to print on standard_output. More
286   --  convenient to use where this is the intended location, and in particular
287   --  easier to use from the debugger.
288
289   procedure Reset;
290   --  Reset all internal data. This is in general not needed, unless you want
291   --  to know what memory is used by specific parts of your application
292
293   procedure Get_Size
294     (Storage_Address          : Address;
295      Size_In_Storage_Elements : out Storage_Count;
296      Valid                    : out Boolean);
297   --  Set Valid if Storage_Address is the address of a chunk of memory
298   --  currently allocated by any pool.
299   --  If Valid is True, Size_In_Storage_Elements is set to the size of this
300   --  chunk of memory.
301
302   type Byte_Count is mod System.Max_Binary_Modulus;
303   --  Type used for maintaining byte counts, needs to be large enough to
304   --  to accommodate counts allowing for repeated use of the same memory.
305
306   function High_Water_Mark
307     (Pool : Debug_Pool) return Byte_Count;
308   --  Return the highest size of the memory allocated by the pool.
309   --  Memory used internally by the pool is not taken into account.
310
311   function Current_Water_Mark
312     (Pool : Debug_Pool) return Byte_Count;
313   --  Return the size of the memory currently allocated by the pool.
314   --  Memory used internally by the pool is not taken into account.
315
316   procedure System_Memory_Debug_Pool
317     (Has_Unhandled_Memory : Boolean := True);
318   --  Let the package know the System.Memory is using it.
319   --  If Has_Unhandled_Memory is true, some deallocation can be done for
320   --  memory not allocated with Allocate.
321
322private
323   --  The following are the standard primitive subprograms for a pool
324
325   procedure Allocate
326     (Pool                     : in out Debug_Pool;
327      Storage_Address          : out Address;
328      Size_In_Storage_Elements : Storage_Count;
329      Alignment                : Storage_Count);
330   --  Allocate a new chunk of memory, and set it up so that the debug pool
331   --  can check accesses to its data, and report incorrect access later on.
332   --  The parameters have the same semantics as defined in the ARM95.
333
334   procedure Deallocate
335     (Pool                     : in out Debug_Pool;
336      Storage_Address          : Address;
337      Size_In_Storage_Elements : Storage_Count;
338      Alignment                : Storage_Count);
339   --  Mark a block of memory as invalid. It might not be physically removed
340   --  immediately, depending on the setup of the debug pool, so that checks
341   --  are still possible. The parameters have the same semantics as defined
342   --  in the RM.
343
344   function Storage_Size (Pool : Debug_Pool) return SSC;
345   --  Return the maximal size of data that can be allocated through Pool.
346   --  Since Pool uses the malloc() system call, all the memory is accessible
347   --  through the pool
348
349   procedure Dereference
350     (Pool                     : in out Debug_Pool;
351      Storage_Address          : System.Address;
352      Size_In_Storage_Elements : Storage_Count;
353      Alignment                : Storage_Count);
354   --  Check whether a dereference statement is valid, i.e. whether the pointer
355   --  was allocated through Pool. As documented above, errors will be
356   --  reported either by a special error message or an exception, depending
357   --  on the setup of the storage pool.
358   --  The parameters have the same semantics as defined in the ARM95.
359
360   type Debug_Pool is new System.Checked_Pools.Checked_Pool with record
361      Stack_Trace_Depth              : Natural := Default_Stack_Trace_Depth;
362      Maximum_Logically_Freed_Memory : SSC     := Default_Max_Freed;
363      Reset_Content_On_Free          : Boolean := Default_Reset_Content;
364      Raise_Exceptions               : Boolean := Default_Raise_Exceptions;
365      Minimum_To_Free                : SSC     := Default_Min_Freed;
366      Advanced_Scanning              : Boolean := Default_Advanced_Scanning;
367      Errors_To_Stdout               : Boolean := Default_Errors_To_Stdout;
368      Low_Level_Traces               : Boolean := Default_Low_Level_Traces;
369
370      Alloc_Count    : Byte_Count := 0;
371      --  Total number of allocation
372
373      Free_Count     : Byte_Count := 0;
374      --  Total number of deallocation
375
376      Allocated : Byte_Count := 0;
377      --  Total number of bytes allocated in this pool
378
379      Logically_Deallocated : Byte_Count := 0;
380      --  Total number of bytes logically deallocated in this pool. This is the
381      --  memory that the application has released, but that the pool has not
382      --  yet physically released through a call to free(), to detect later
383      --  accessed to deallocated memory.
384
385      Physically_Deallocated : Byte_Count := 0;
386      --  Total number of bytes that were free()-ed
387
388      Marked_Blocks_Deallocated : Boolean := False;
389      --  Set to true if some mark blocks had to be deallocated in the advanced
390      --  scanning scheme. Since this is potentially dangerous, this is
391      --  reported to the user, who might want to rerun his program with a
392      --  lower Minimum_To_Free value.
393
394      High_Water : Byte_Count := 0;
395      --  Maximum of Allocated - Logically_Deallocated - Physically_Deallocated
396
397      First_Free_Block : System.Address := System.Null_Address;
398      Last_Free_Block  : System.Address := System.Null_Address;
399      --  Pointers to the first and last logically freed blocks
400
401      First_Used_Block : System.Address := System.Null_Address;
402      --  Pointer to the list of currently allocated blocks. This list is
403      --  used to list the memory leaks in the application on exit, as well as
404      --  for the advanced freeing algorithms that needs to traverse all these
405      --  blocks to find possible references to the block being physically
406      --  freed.
407
408   end record;
409end GNAT.Debug_Pools;
410