1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2004 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 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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Hostparm; use Hostparm;
28 with Namet; use Namet;
29 with Output; use Output;
33 ----------------------
34 -- Is_Internal_Unit --
35 ----------------------
37 -- Note: the reason we do not use the Fname package for this function
38 -- is that it would drag too much junk into the binder.
40 function Is_Internal_Unit return Boolean is
42 return Is_Predefined_Unit
44 and then (Name_Buffer (1 .. 5) = "gnat%"
46 Name_Buffer (1 .. 5) = "gnat."))
50 and then (Name_Buffer (1 .. 4) = "dec%"
52 Name_Buffer (1 .. 4) = "dec."));
56 ------------------------
57 -- Is_Predefined_Unit --
58 ------------------------
60 -- Note: the reason we do not use the Fname package for this function
61 -- is that it would drag too much junk into the binder.
63 function Is_Predefined_Unit return Boolean is
66 and then Name_Buffer (1 .. 4) = "ada.")
69 and then Name_Buffer (1 .. 7) = "system.")
71 or else (Name_Len > 10
72 and then Name_Buffer (1 .. 11) = "interfaces.")
75 and then Name_Buffer (1 .. 4) = "ada%")
78 and then Name_Buffer (1 .. 9) = "calendar%")
81 and then Name_Buffer (1 .. 10) = "direct_io%")
83 or else (Name_Len > 10
84 and then Name_Buffer (1 .. 11) = "interfaces%")
86 or else (Name_Len > 13
87 and then Name_Buffer (1 .. 14) = "io_exceptions%")
89 or else (Name_Len > 12
90 and then Name_Buffer (1 .. 13) = "machine_code%")
92 or else (Name_Len > 13
93 and then Name_Buffer (1 .. 14) = "sequential_io%")
96 and then Name_Buffer (1 .. 7) = "system%")
99 and then Name_Buffer (1 .. 8) = "text_io%")
101 or else (Name_Len > 20
102 and then Name_Buffer (1 .. 21) = "unchecked_conversion%")
104 or else (Name_Len > 22
105 and then Name_Buffer (1 .. 23) = "unchecked_deallocation%")
107 or else (Name_Len > 4
108 and then Name_Buffer (1 .. 5) = "gnat%")
110 or else (Name_Len > 4
111 and then Name_Buffer (1 .. 5) = "gnat.");
112 end Is_Predefined_Unit;
118 function Uname_Less (U1, U2 : Unit_Name_Type) return Boolean is
120 Get_Name_String (U1);
123 U1_Name : constant String (1 .. Name_Len) :=
124 Name_Buffer (1 .. Name_Len);
125 Min_Length : Natural;
128 Get_Name_String (U2);
130 if Name_Len < U1_Name'Last then
131 Min_Length := Name_Len;
133 Min_Length := U1_Name'Last;
136 for I in 1 .. Min_Length loop
137 if U1_Name (I) > Name_Buffer (I) then
139 elsif U1_Name (I) < Name_Buffer (I) then
144 return U1_Name'Last < Name_Len;
148 ---------------------
149 -- Write_Unit_Name --
150 ---------------------
152 procedure Write_Unit_Name (U : Unit_Name_Type) is
155 Write_Str (Name_Buffer (1 .. Name_Len - 2));
157 if Name_Buffer (Name_Len) = 's' then
158 Write_Str (" (spec)");
160 Write_Str (" (body)");
163 Name_Len := Name_Len + 5;