|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT SYSTEM UTILITIES --
|
|
|
4 -- --
|
|
|
5 -- X S N A M E S T --
|
|
|
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. 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 COPYING3. If not, go to --
|
|
|
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
|
|
|
20 -- --
|
|
|
21 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
23 -- --
|
|
|
24 ------------------------------------------------------------------------------
|
|
|
25
|
|
|
26 -- This utility is used to make a new version of the Snames package when new
|
|
|
27 -- names are added. This version reads a template file from snames.ads-tmpl in
|
|
|
28 -- which the numbers are all written as $, and generates a new version of the
|
|
|
29 -- spec file snames.ads (written to snames.ns). It also reads snames.adb-tmpl
|
|
|
30 -- and generates an updated body (written to snames.nb), and snames.h-tmpl and
|
|
|
31 -- generates an updated C header file (written to snames.nh).
|
|
|
32
|
|
|
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;
|
|
|
38 with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
|
|
|
39
|
|
|
40 with GNAT.Spitbol; use GNAT.Spitbol;
|
|
|
41 with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns;
|
|
|
42
|
|
|
43 with XUtil; use XUtil;
|
|
|
44
|
|
|
45 procedure XSnamesT is
|
|
|
46
|
|
|
47 subtype VString is GNAT.Spitbol.VString;
|
|
|
48
|
|
|
49 InS : Ada.Text_IO.File_Type;
|
|
|
50 InB : Ada.Text_IO.File_Type;
|
|
|
51 InH : Ada.Text_IO.File_Type;
|
|
|
52
|
|
|
53 OutS : Ada.Streams.Stream_IO.File_Type;
|
|
|
54 OutB : Ada.Streams.Stream_IO.File_Type;
|
|
|
55 OutH : Ada.Streams.Stream_IO.File_Type;
|
|
|
56
|
|
|
57 A, B : VString := Nul;
|
|
|
58 Line : VString := Nul;
|
|
|
59 Name0 : VString := Nul;
|
|
|
60 Name1 : VString := Nul;
|
|
|
61 Oval : VString := Nul;
|
|
|
62 Restl : VString := Nul;
|
|
|
63
|
|
|
64 Name_Ref : constant Pattern := Span (' ') * A & Break (' ') * Name0
|
|
|
65 & Span (' ') * B
|
|
|
66 & ": constant Name_Id := N + $;"
|
|
|
67 & Rest * Restl;
|
|
|
68
|
|
|
69 Get_Name : constant Pattern := "Name_" & Rest * Name1;
|
|
|
70 Chk_Low : constant Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1);
|
|
|
71 Findu : constant Pattern := Span ('u') * A;
|
|
|
72
|
|
|
73 Val : Natural;
|
|
|
74
|
|
|
75 Xlate_U_Und : constant Character_Mapping := To_Mapping ("u", "_");
|
|
|
76
|
|
|
77 M : Match_Result;
|
|
|
78
|
|
|
79 type Header_Symbol is (None, Name, Attr, Conv, Prag);
|
|
|
80 -- A symbol in the header file
|
|
|
81
|
|
|
82 procedure Output_Header_Line (S : Header_Symbol);
|
|
|
83 -- Output header line
|
|
|
84
|
|
|
85 Header_Name : aliased String := "Name";
|
|
|
86 Header_Attr : aliased String := "Attr";
|
|
|
87 Header_Conv : aliased String := "Convention";
|
|
|
88 Header_Prag : aliased String := "Pragma";
|
|
|
89 -- Prefixes used in the header file
|
|
|
90
|
|
|
91 type String_Ptr is access all String;
|
|
|
92 Header_Prefix : constant array (Header_Symbol) of String_Ptr :=
|
|
|
93 (null,
|
|
|
94 Header_Name'Access,
|
|
|
95 Header_Attr'Access,
|
|
|
96 Header_Conv'Access,
|
|
|
97 Header_Prag'Access);
|
|
|
98
|
|
|
99 -- Patterns used in the spec file
|
|
|
100
|
|
|
101 Get_Attr : constant Pattern := Span (' ') & "Attribute_"
|
|
|
102 & Break (",)") * Name1;
|
|
|
103 Get_Conv : constant Pattern := Span (' ') & "Convention_"
|
|
|
104 & Break (",)") * Name1;
|
|
|
105 Get_Prag : constant Pattern := Span (' ') & "Pragma_"
|
|
|
106 & Break (",)") * Name1;
|
|
|
107
|
|
|
108 type Header_Symbol_Counter is array (Header_Symbol) of Natural;
|
|
|
109 Header_Counter : Header_Symbol_Counter := (0, 0, 0, 0, 0);
|
|
|
110
|
|
|
111 Header_Current_Symbol : Header_Symbol := None;
|
|
|
112 Header_Pending_Line : VString := Nul;
|
|
|
113
|
|
|
114 ------------------------
|
|
|
115 -- Output_Header_Line --
|
|
|
116 ------------------------
|
|
|
117
|
|
|
118 procedure Output_Header_Line (S : Header_Symbol) is
|
|
|
119 function Make_Value (V : Integer) return String;
|
|
|
120 -- Build the definition for the current macro (Names are integers
|
|
|
121 -- offset to N, while other items are enumeration values).
|
|
|
122
|
|
|
123 ----------------
|
|
|
124 -- Make_Value --
|
|
|
125 ----------------
|
|
|
126
|
|
|
127 function Make_Value (V : Integer) return String is
|
|
|
128 begin
|
|
|
129 if S = Name then
|
|
|
130 return "(First_Name_Id + 256 + " & V & ")";
|
|
|
131 else
|
|
|
132 return "" & V;
|
|
|
133 end if;
|
|
|
134 end Make_Value;
|
|
|
135
|
|
|
136 -- Start of processing for Output_Header_Line
|
|
|
137
|
|
|
138 begin
|
|
|
139 -- Skip all the #define for S-prefixed symbols in the header.
|
|
|
140 -- Of course we are making implicit assumptions:
|
|
|
141 -- (1) No newline between symbols with the same prefix.
|
|
|
142 -- (2) Prefix order is the same as in snames.ads.
|
|
|
143
|
|
|
144 if Header_Current_Symbol /= S then
|
|
|
145 declare
|
|
|
146 Name2 : VString;
|
|
|
147 Pat : constant Pattern := "#define "
|
|
|
148 & Header_Prefix (S).all
|
|
|
149 & Break (' ') * Name2;
|
|
|
150 In_Pat : Boolean := False;
|
|
|
151
|
|
|
152 begin
|
|
|
153 if Header_Current_Symbol /= None then
|
|
|
154 Put_Line (OutH, Header_Pending_Line);
|
|
|
155 end if;
|
|
|
156
|
|
|
157 loop
|
|
|
158 Line := Get_Line (InH);
|
|
|
159
|
|
|
160 if Match (Line, Pat) then
|
|
|
161 In_Pat := True;
|
|
|
162 elsif In_Pat then
|
|
|
163 Header_Pending_Line := Line;
|
|
|
164 exit;
|
|
|
165 else
|
|
|
166 Put_Line (OutH, Line);
|
|
|
167 end if;
|
|
|
168 end loop;
|
|
|
169
|
|
|
170 Header_Current_Symbol := S;
|
|
|
171 end;
|
|
|
172 end if;
|
|
|
173
|
|
|
174 -- Now output the line
|
|
|
175
|
|
|
176 -- Note that we must ensure at least one space between macro name and
|
|
|
177 -- parens, otherwise the parenthesized value gets treated as an argument
|
|
|
178 -- specification.
|
|
|
179
|
|
|
180 Put_Line (OutH, "#define " & Header_Prefix (S).all
|
|
|
181 & "_" & Name1
|
|
|
182 & (30 - Natural'Min (29, Length (Name1))) * ' '
|
|
|
183 & Make_Value (Header_Counter (S)));
|
|
|
184 Header_Counter (S) := Header_Counter (S) + 1;
|
|
|
185 end Output_Header_Line;
|
|
|
186
|
|
|
187 -- Start of processing for XSnames
|
|
|
188
|
|
|
189 begin
|
|
|
190 Open (InS, In_File, "snames.ads-tmpl");
|
|
|
191 Open (InB, In_File, "snames.adb-tmpl");
|
|
|
192 Open (InH, In_File, "snames.h-tmpl");
|
|
|
193
|
|
|
194 -- Note that we do not generate snames.{ads,adb,h} directly. Instead
|
|
|
195 -- we output them to snames.n{s,b,h} so that Makefiles can use
|
|
|
196 -- move-if-change to not touch previously generated files if the
|
|
|
197 -- new ones are identical.
|
|
|
198
|
|
|
199 Create (OutS, Out_File, "snames.ns");
|
|
|
200 Create (OutB, Out_File, "snames.nb");
|
|
|
201 Create (OutH, Out_File, "snames.nh");
|
|
|
202
|
|
|
203 Put_Line (OutH, "#ifdef __cplusplus");
|
|
|
204 Put_Line (OutH, "extern ""C"" {");
|
|
|
205 Put_Line (OutH, "#endif");
|
|
|
206
|
|
|
207 Anchored_Mode := True;
|
|
|
208 Val := 0;
|
|
|
209
|
|
|
210 loop
|
|
|
211 Line := Get_Line (InB);
|
|
|
212 exit when Match (Line, " Preset_Names");
|
|
|
213 Put_Line (OutB, Line);
|
|
|
214 end loop;
|
|
|
215
|
|
|
216 Put_Line (OutB, Line);
|
|
|
217
|
|
|
218 LoopN : while not End_Of_File (InS) loop
|
|
|
219 Line := Get_Line (InS);
|
|
|
220
|
|
|
221 if not Match (Line, Name_Ref) then
|
|
|
222 Put_Line (OutS, Line);
|
|
|
223
|
|
|
224 if Match (Line, Get_Attr) then
|
|
|
225 Output_Header_Line (Attr);
|
|
|
226 elsif Match (Line, Get_Conv) then
|
|
|
227 Output_Header_Line (Conv);
|
|
|
228 elsif Match (Line, Get_Prag) then
|
|
|
229 Output_Header_Line (Prag);
|
|
|
230 end if;
|
|
|
231 else
|
|
|
232
|
|
|
233 if Match (Name0, "Last_") then
|
|
|
234 Oval := Lpad (V (Val - 1), 3, '0');
|
|
|
235 else
|
|
|
236 Oval := Lpad (V (Val), 3, '0');
|
|
|
237 end if;
|
|
|
238
|
|
|
239 Put_Line
|
|
|
240 (OutS, A & Name0 & B & ": constant Name_Id := N + "
|
|
|
241 & Oval & ';' & Restl);
|
|
|
242
|
|
|
243 if Match (Name0, Get_Name) then
|
|
|
244 Name0 := Name1;
|
|
|
245 Val := Val + 1;
|
|
|
246
|
|
|
247 if Match (Name0, Findu, M) then
|
|
|
248 Replace (M, Translate (A, Xlate_U_Und));
|
|
|
249 Translate (Name0, Lower_Case_Map);
|
|
|
250
|
|
|
251 elsif not Match (Name0, "Op_", "") then
|
|
|
252 Translate (Name0, Lower_Case_Map);
|
|
|
253
|
|
|
254 else
|
|
|
255 Name0 := 'O' & Translate (Name0, Lower_Case_Map);
|
|
|
256 end if;
|
|
|
257
|
|
|
258 if not Match (Name0, Chk_Low) then
|
|
|
259 Put_Line (OutB, " """ & Name0 & "#"" &");
|
|
|
260 end if;
|
|
|
261
|
|
|
262 Output_Header_Line (Name);
|
|
|
263 end if;
|
|
|
264 end if;
|
|
|
265 end loop LoopN;
|
|
|
266
|
|
|
267 loop
|
|
|
268 Line := Get_Line (InB);
|
|
|
269 exit when Match (Line, " ""#"";");
|
|
|
270 end loop;
|
|
|
271
|
|
|
272 Put_Line (OutB, Line);
|
|
|
273
|
|
|
274 while not End_Of_File (InB) loop
|
|
|
275 Line := Get_Line (InB);
|
|
|
276 Put_Line (OutB, Line);
|
|
|
277 end loop;
|
|
|
278
|
|
|
279 Put_Line (OutH, Header_Pending_Line);
|
|
|
280 while not End_Of_File (InH) loop
|
|
|
281 Line := Get_Line (InH);
|
|
|
282 Put_Line (OutH, Line);
|
|
|
283 end loop;
|
|
|
284
|
|
|
285 Put_Line (OutH, "#ifdef __cplusplus");
|
|
|
286 Put_Line (OutH, "}");
|
|
|
287 Put_Line (OutH, "#endif");
|
|
|
288 end XSnamesT;
|
