File : s-memory-raven-min.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- S Y S T E M . M E M O R Y --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2013-2014, 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 -- --
19 -- --
20 -- --
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 -- Simple implementation for use with Ravenscar Minimal. This implementation
33 -- is based on a simple static buffer (whose bounds are defined in the linker
34 -- script), and allocation is performed through a protected object to
35 -- protect against concurrency.
36
37 pragma Restrictions (No_Elaboration_Code);
38 -- This unit may be linked without being with'ed, so we need to ensure
39 -- there is no elaboration code (since this code might not be executed).
40
41 with System.Storage_Elements;
42 with Unchecked_Conversion;
43
44 package body System.Memory is
45 use System.Storage_Elements;
46
47 Heap_Start : Character;
48 for Heap_Start'Alignment use Standard'Maximum_Alignment;
49 pragma Import (C, Heap_Start, "__heap_start");
50 -- The address of the variable is the start of the heap
51
52 Heap_End : Character;
53 pragma Import (C, Heap_End, "__heap_end");
54 -- The address of the variable is the end of the heap
55
56 Top : aliased Address := Heap_Start'Address;
57 -- First not used address (always aligned to the maximum alignment).
58
59 -----------
60 -- Alloc --
61 -----------
62
63 function Alloc (Size : size_t) return System.Address is
64 function Compare_And_Swap
65 (Ptr : access Address;
66 Old_Val : Integer_Address;
67 New_Val : Integer_Address) return Boolean;
68 pragma Import (Intrinsic, Compare_And_Swap,
69 "__sync_bool_compare_and_swap_4");
70 -- Atomic compare and swap. If the current value of Ptr.all is Old_Val,
71 -- write New_Val to Ptr.all. Return True if the comparaison was
72 -- successful.
73
74 Max_Align : constant := Standard'Maximum_Alignment;
75 Max_Size : Storage_Count;
76 Res : Address;
77
78 begin
79 if Size = 0 then
80
81 -- Change size from zero to non-zero. We still want a proper pointer
82 -- for the zero case because pointers to zero length objects have to
83 -- be distinct.
84
85 Max_Size := Max_Align;
86
87 else
88 -- Detect overflow in the addition below. Note that we know that
89 -- upper bound of size_t is bigger than the upper bound of
90 -- Storage_Count.
91
92 if Size > size_t (Storage_Count'Last - Max_Align) then
93 raise Storage_Error;
94 end if;
95
96 -- Compute aligned size
97
98 Max_Size :=
99 ((Storage_Count (Size) + Max_Align - 1) / Max_Align) * Max_Align;
100 end if;
101
102 loop
103 Res := Top;
104
105 -- Detect too large allocation
106
107 if Max_Size >= Storage_Count (Heap_End'Address - Res) then
108 raise Storage_Error;
109 end if;
110
111 -- Atomically update the top of the heap. Restart in case of
112 -- failure (concurrent allocation).
113
114 exit when Compare_And_Swap
115 (Top'Access,
116 Integer_Address (Res),
117 Integer_Address (Res + Max_Size));
118 end loop;
119
120 return Res;
121 end Alloc;
122
123 end System.Memory;