1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with System
; use System
;
33 with Tree_IO
; use Tree_IO
;
35 with System
.Memory
; use System
.Memory
;
37 with Unchecked_Conversion
;
42 function Tree_Get_Table_Address
return Address
;
43 -- Return Null_Address if the table length is zero,
44 -- Table (First)'Address if not.
46 ----------------------------
47 -- Tree_Get_Table_Address --
48 ----------------------------
50 function Tree_Get_Table_Address
return Address
is
55 return Table
(First
)'Address;
57 end Tree_Get_Table_Address
;
63 -- Note: we allocate only the space required to accommodate the data
64 -- actually written, which means that a Tree_Write/Tree_Read sequence
65 -- does an implicit Release.
67 procedure Tree_Read
is
72 Set_Last
(Table_Last_Type
(Last
));
75 (Tree_Get_Table_Address
,
76 (Last
- Int
(First
) + 1) *
78 -- Note the importance of parenthesizing the following division
79 -- to avoid the possibility of intermediate overflow.
81 (Table_Type
'Component_Size / Storage_Unit
));
88 -- Note: we write out only the currently valid data, not the entire
89 -- contents of the allocated array. See note above on Tree_Read.
91 procedure Tree_Write
is
93 Tree_Write_Int
(Int
(Last
));
95 (Tree_Get_Table_Address
,
96 (Int
(Last
- First
) + 1) *
97 (Table_Type
'Component_Size / Storage_Unit
));