1 ------------------------------------------------------------------------------
3 -- GNAT SYSTEM UTILITIES --
9 -- Copyright (C) 1992-2005, 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 -- This utility is used to make a new version of the Snames package when new
28 -- names are added to the spec, the existing versions of snames.ads and
29 -- snames.adb and snames.h are read, and updated to match the set of names in
30 -- snames.ads. The updated versions are written to snames.ns, snames.nb (new
31 -- spec/body), and snames.nh (new header file).
33 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
34 with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
35 with Ada.Strings.Maps; use Ada.Strings.Maps;
36 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
37 with Ada.Text_IO; use Ada.Text_IO;
39 with GNAT.Spitbol; use GNAT.Spitbol;
40 with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns;
51 A, B : VString := Nul;
52 Line : VString := Nul;
53 Name : VString := Nul;
54 Name1 : VString := Nul;
55 Oname : VString := Nul;
56 Oval : VString := Nul;
57 Restl : VString := Nul;
59 Tdigs : Pattern := Any (Decimal_Digit_Set) &
60 Any (Decimal_Digit_Set) &
61 Any (Decimal_Digit_Set);
63 Name_Ref : Pattern := Span (' ') * A & Break (' ') * Name
65 & ": constant Name_Id := N + " & Tdigs
68 Get_Name : Pattern := "Name_" & Rest * Name1;
70 Chk_Low : Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1);
72 Findu : Pattern := Span ('u') * A;
76 Xlate_U_Und : Character_Mapping := To_Mapping ("u", "_");
80 type Header_Symbol is (None, Attr, Conv, Prag);
81 -- A symbol in the header file
83 -- Prefixes used in the header file
85 Header_Attr : aliased String := "Attr";
86 Header_Conv : aliased String := "Convention";
87 Header_Prag : aliased String := "Pragma";
89 type String_Ptr is access all String;
90 Header_Prefix : constant array (Header_Symbol) of String_Ptr :=
96 -- Patterns used in the spec file
98 Get_Attr : Pattern := Span (' ') & "Attribute_" & Break (",)") * Name1;
99 Get_Conv : Pattern := Span (' ') & "Convention_" & Break (",)") * Name1;
100 Get_Prag : Pattern := Span (' ') & "Pragma_" & Break (",)") * Name1;
102 type Header_Symbol_Counter is array (Header_Symbol) of Natural;
103 Header_Counter : Header_Symbol_Counter := (0, 0, 0, 0);
105 Header_Current_Symbol : Header_Symbol := None;
106 Header_Pending_Line : VString := Nul;
108 ------------------------
109 -- Output_Header_Line --
110 ------------------------
112 procedure Output_Header_Line (S : Header_Symbol) is
114 -- Skip all the #define for S-prefixed symbols in the header.
115 -- Of course we are making implicit assumptions:
116 -- (1) No newline between symbols with the same prefix.
117 -- (2) Prefix order is the same as in snames.ads.
119 if Header_Current_Symbol /= S then
121 Pat : String := "#define " & Header_Prefix (S).all;
122 In_Pat : Boolean := False;
125 if Header_Current_Symbol /= None then
126 Put_Line (OutH, Header_Pending_Line);
130 Line := Get_Line (InH);
132 if Match (Line, Pat) then
135 Header_Pending_Line := Line;
138 Put_Line (OutH, Line);
142 Header_Current_Symbol := S;
146 -- Now output the line
148 Put_Line (OutH, "#define " & Header_Prefix (S).all
149 & "_" & Name1 & (30 - Length (Name1)) * ' '
150 & Header_Counter (S));
151 Header_Counter (S) := Header_Counter (S) + 1;
152 end Output_Header_Line;
154 -- Start of processing for XSnames
157 Open (InB, In_File, "snames.adb");
158 Open (InS, In_File, "snames.ads");
159 Open (InH, In_File, "snames.h");
161 Create (OutS, Out_File, "snames.ns");
162 Create (OutB, Out_File, "snames.nb");
163 Create (OutH, Out_File, "snames.nh");
165 Anchored_Mode := True;
170 Line := Get_Line (InB);
171 exit when Match (Line, " Preset_Names");
172 Put_Line (OutB, Line);
175 Put_Line (OutB, Line);
177 LoopN : while not End_Of_File (InS) loop
178 Line := Get_Line (InS);
180 if not Match (Line, Name_Ref) then
181 Put_Line (OutS, Line);
183 if Match (Line, Get_Attr) then
184 Output_Header_Line (Attr);
185 elsif Match (Line, Get_Conv) then
186 Output_Header_Line (Conv);
187 elsif Match (Line, Get_Prag) then
188 Output_Header_Line (Prag);
191 Oval := Lpad (V (Val), 3, '0');
193 if Match (Name, "Last_") then
194 Oval := Lpad (V (Val - 1), 3, '0');
198 (OutS, A & Name & B & ": constant Name_Id := N + "
199 & Oval & ';' & Restl);
201 if Match (Name, Get_Name) then
205 if Match (Name, Findu, M) then
206 Replace (M, Translate (A, Xlate_U_Und));
207 Translate (Name, Lower_Case_Map);
209 elsif not Match (Name, "Op_", "") then
210 Translate (Name, Lower_Case_Map);
213 Name := 'O' & Translate (Name, Lower_Case_Map);
216 if Name = "error" then
217 Name := V ("<error>");
220 if not Match (Name, Chk_Low) then
221 Put_Line (OutB, " """ & Name & "#"" &");
228 Line := Get_Line (InB);
229 exit when Match (Line, " ""#"";");
232 Put_Line (OutB, Line);
234 while not End_Of_File (InB) loop
235 Line := Get_Line (InB);
236 Put_Line (OutB, Line);
239 Put_Line (OutH, Header_Pending_Line);
240 while not End_Of_File (InH) loop
241 Line := Get_Line (InH);
242 Put_Line (OutH, Line);