1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                 S Y S T E M . P O O L _ 3 2 _ G L O B A L                --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1992-2011, 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
32with System.Storage_Pools; use System.Storage_Pools;
33with System.Memory;
34
35package body System.Pool_32_Global is
36
37   package SSE renames System.Storage_Elements;
38
39   --------------
40   -- Allocate --
41   --------------
42
43   overriding procedure Allocate
44     (Pool         : in out Unbounded_No_Reclaim_Pool_32;
45      Address      : out System.Address;
46      Storage_Size : SSE.Storage_Count;
47      Alignment    : SSE.Storage_Count)
48   is
49      pragma Warnings (Off, Pool);
50      pragma Warnings (Off, Alignment);
51
52   begin
53      Address := Memory.Alloc32 (Memory.size_t (Storage_Size));
54
55      --  The call to Alloc returns an address whose alignment is compatible
56      --  with the worst case alignment requirement for the machine; thus the
57      --  Alignment argument can be safely ignored.
58
59      if Address = Null_Address then
60         raise Storage_Error;
61      end if;
62   end Allocate;
63
64   ----------------
65   -- Deallocate --
66   ----------------
67
68   overriding procedure Deallocate
69     (Pool         : in out Unbounded_No_Reclaim_Pool_32;
70      Address      : System.Address;
71      Storage_Size : SSE.Storage_Count;
72      Alignment    : SSE.Storage_Count)
73   is
74      pragma Warnings (Off, Pool);
75      pragma Warnings (Off, Storage_Size);
76      pragma Warnings (Off, Alignment);
77
78   begin
79      Memory.Free (Address);
80   end Deallocate;
81
82   ------------------
83   -- Storage_Size --
84   ------------------
85
86   overriding function Storage_Size
87     (Pool  : Unbounded_No_Reclaim_Pool_32)
88      return  SSE.Storage_Count
89   is
90      pragma Warnings (Off, Pool);
91
92   begin
93      --  The 32 bit heap is limited to 2 GB of memory
94
95      return SSE.Storage_Count (2 ** 31);
96   end Storage_Size;
97
98end System.Pool_32_Global;
99