OSDN Git Service

Fix copyright problems reported by Doug Evans.
[pf3gnuchains/gcc-fork.git] / gcc / ada / g-debpoo.ads
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-2001 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 2,  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.  See the GNU General Public License --
17 -- for  more details.  You should have  received  a copy of the GNU General --
18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
19 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
20 -- MA 02111-1307, USA.                                                      --
21 --                                                                          --
22 -- As a special exception,  if other files  instantiate  generics from this --
23 -- unit, or you link  this unit with other files  to produce an executable, --
24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
25 -- covered  by the  GNU  General  Public  License.  This exception does not --
26 -- however invalidate  any other reasons why  the executable file  might be --
27 -- covered by the  GNU Public License.                                      --
28 --                                                                          --
29 -- GNAT was originally developed  by the GNAT team at  New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
31 --                                                                          --
32 ------------------------------------------------------------------------------
33
34 with System;                  use System;
35 with System.Storage_Elements; use System.Storage_Elements;
36 with System.Checked_Pools;
37
38 package GNAT.Debug_Pools is
39
40    --  The debug pool is used to track down memory corruption due to use of
41    --  deallocated memory or incorrect unchecked conversions. Allocation
42    --  strategy :
43
44    --     - allocation:   . memory is normally allocated with malloc
45    --                     . the allocated address is noted in a table
46
47    --     - deallocation: . memory is  filled with "DEAD_BEEF" patterns
48    --                     . memory is not freed
49    --                     . exceptions are raised if the memory was not
50    --                       allocated or was already deallocated
51
52    --     - dereference:  . exceptions are raised if the memory was not
53    --                        allocated or was already deallocated
54
55    Accessing_Not_Allocated_Storage : exception;
56    Accessing_Deallocated_Storage   : exception;
57    Freeing_Not_Allocated_Storage   : exception;
58    Freeing_Deallocated_Storage     : exception;
59
60    type Debug_Pool is
61      new System.Checked_Pools.Checked_Pool with private;
62
63    procedure Allocate
64      (Pool                     : in out Debug_Pool;
65       Storage_Address          : out Address;
66       Size_In_Storage_Elements : Storage_Count;
67       Alignment                : Storage_Count);
68
69    procedure Deallocate
70      (Pool                     : in out Debug_Pool;
71       Storage_Address          : Address;
72       Size_In_Storage_Elements : Storage_Count;
73       Alignment                : Storage_Count);
74
75    function Storage_Size
76      (Pool : Debug_Pool)
77       return System.Storage_Elements.Storage_Count;
78
79    procedure Dereference
80      (Pool                     : in out Debug_Pool;
81       Storage_Address          : System.Address;
82       Size_In_Storage_Elements : Storage_Count;
83       Alignment                : Storage_Count);
84
85    generic
86       with procedure Put_Line (S : String);
87    procedure Print_Info (Pool : Debug_Pool);
88    --  Print out information about the High Water Mark, the current and
89    --  total number of bytes allocated and the total number of bytes
90    --  deallocated.
91
92 private
93    type Debug_Pool is new System.Checked_Pools.Checked_Pool with record
94       Allocated   : Storage_Count := 0;
95       --  Total number of bytes allocated in this pool
96
97       Deallocated : Storage_Count := 0;
98       --  Total number of bytes deallocated in this pool
99
100       High_Water  : Storage_Count := 0;
101       --  Maximum of during the time of Allocated - Deallocated
102    end record;
103 end GNAT.Debug_Pools;