File : s-stoele.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S Y S T E M . S T O R A G E _ E L E M E N T S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-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 pragma Compiler_Unit_Warning;
33
34 with Ada.Unchecked_Conversion;
35
36 package body System.Storage_Elements is
37
38 pragma Suppress (All_Checks);
39
40 -- Conversion to/from address
41
42 -- Note qualification below of To_Address to avoid ambiguities systems
43 -- where Address is a visible integer type.
44
45 function To_Address is
46 new Ada.Unchecked_Conversion (Storage_Offset, Address);
47 function To_Offset is
48 new Ada.Unchecked_Conversion (Address, Storage_Offset);
49
50 -- Conversion to/from integers
51
52 -- These functions must be place first because they are inlined_always
53 -- and are used and inlined in other subprograms defined in this unit.
54
55 ----------------
56 -- To_Address --
57 ----------------
58
59 function To_Address (Value : Integer_Address) return Address is
60 begin
61 return Address (Value);
62 end To_Address;
63
64 ----------------
65 -- To_Integer --
66 ----------------
67
68 function To_Integer (Value : Address) return Integer_Address is
69 begin
70 return Integer_Address (Value);
71 end To_Integer;
72
73 -- Address arithmetic
74
75 ---------
76 -- "+" --
77 ---------
78
79 function "+" (Left : Address; Right : Storage_Offset) return Address is
80 begin
81 return Storage_Elements.To_Address
82 (To_Integer (Left) + To_Integer (To_Address (Right)));
83 end "+";
84
85 function "+" (Left : Storage_Offset; Right : Address) return Address is
86 begin
87 return Storage_Elements.To_Address
88 (To_Integer (To_Address (Left)) + To_Integer (Right));
89 end "+";
90
91 ---------
92 -- "-" --
93 ---------
94
95 function "-" (Left : Address; Right : Storage_Offset) return Address is
96 begin
97 return Storage_Elements.To_Address
98 (To_Integer (Left) - To_Integer (To_Address (Right)));
99 end "-";
100
101 function "-" (Left, Right : Address) return Storage_Offset is
102 begin
103 return To_Offset (Storage_Elements.To_Address
104 (To_Integer (Left) - To_Integer (Right)));
105 end "-";
106
107 -----------
108 -- "mod" --
109 -----------
110
111 function "mod"
112 (Left : Address;
113 Right : Storage_Offset) return Storage_Offset
114 is
115 begin
116 if Right > 0 then
117 return Storage_Offset
118 (To_Integer (Left) mod Integer_Address (Right));
119
120 -- The negative case makes no sense since it is a case of a mod where
121 -- the left argument is unsigned and the right argument is signed. In
122 -- accordance with the (spirit of the) permission of RM 13.7.1(16),
123 -- we raise CE, and also include the zero case here. Yes, the RM says
124 -- PE, but this really is so obviously more like a constraint error.
125
126 else
127 raise Constraint_Error;
128 end if;
129 end "mod";
130
131 end System.Storage_Elements;