]>
Commit | Line | Data |
---|---|---|
589f1edf GB |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT SYSTEM UTILITIES -- | |
4 | -- -- | |
5 | -- X S N A M E S -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
b5c84c3c | 9 | -- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- |
589f1edf GB |
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- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
589f1edf GB |
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 -- | |
b5c84c3c RD |
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. -- | |
589f1edf GB |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
589f1edf GB |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
84fdd8a3 AC |
26 | -- This utility is used to make a new version of the Snames package when new |
27 | -- names are added to the spec, the existing versions of snames.ads and | |
28 | -- snames.adb and snames.h are read, and updated to match the set of names in | |
29 | -- snames.ads. The updated versions are written to snames.ns, snames.nb (new | |
30 | -- spec/body), and snames.nh (new header file). | |
589f1edf GB |
31 | |
32 | with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; | |
33 | with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; | |
34 | with Ada.Strings.Maps; use Ada.Strings.Maps; | |
35 | with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; | |
36 | with Ada.Text_IO; use Ada.Text_IO; | |
37 | ||
38 | with GNAT.Spitbol; use GNAT.Spitbol; | |
39 | with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; | |
40 | ||
41 | procedure XSnames is | |
42 | ||
43 | InB : File_Type; | |
44 | InS : File_Type; | |
45 | OutS : File_Type; | |
46 | OutB : File_Type; | |
84fdd8a3 AC |
47 | InH : File_Type; |
48 | OutH : File_Type; | |
589f1edf GB |
49 | |
50 | A, B : VString := Nul; | |
51 | Line : VString := Nul; | |
52 | Name : VString := Nul; | |
53 | Name1 : VString := Nul; | |
589f1edf GB |
54 | Oname : VString := Nul; |
55 | Oval : VString := Nul; | |
56 | Restl : VString := Nul; | |
589f1edf GB |
57 | |
58 | Tdigs : Pattern := Any (Decimal_Digit_Set) & | |
59 | Any (Decimal_Digit_Set) & | |
60 | Any (Decimal_Digit_Set); | |
61 | ||
589f1edf GB |
62 | Name_Ref : Pattern := Span (' ') * A & Break (' ') * Name |
63 | & Span (' ') * B | |
64 | & ": constant Name_Id := N + " & Tdigs | |
65 | & ';' & Rest * Restl; | |
66 | ||
67 | Get_Name : Pattern := "Name_" & Rest * Name1; | |
68 | ||
69 | Chk_Low : Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1); | |
70 | ||
71 | Findu : Pattern := Span ('u') * A; | |
72 | ||
73 | Val : Natural; | |
74 | ||
75 | Xlate_U_Und : Character_Mapping := To_Mapping ("u", "_"); | |
76 | ||
77 | M : Match_Result; | |
78 | ||
84fdd8a3 AC |
79 | type Header_Symbol is (None, Attr, Conv, Prag); |
80 | -- A symbol in the header file | |
81 | ||
82 | -- Prefixes used in the header file | |
83 | ||
84 | Header_Attr : aliased String := "Attr"; | |
85 | Header_Conv : aliased String := "Convention"; | |
86 | Header_Prag : aliased String := "Pragma"; | |
87 | ||
88 | type String_Ptr is access all String; | |
89 | Header_Prefix : constant array (Header_Symbol) of String_Ptr := | |
90 | (null, | |
91 | Header_Attr'Access, | |
92 | Header_Conv'Access, | |
93 | Header_Prag'Access); | |
94 | ||
95 | -- Patterns used in the spec file | |
96 | ||
97 | Get_Attr : Pattern := Span (' ') & "Attribute_" & Break (",)") * Name1; | |
98 | Get_Conv : Pattern := Span (' ') & "Convention_" & Break (",)") * Name1; | |
99 | Get_Prag : Pattern := Span (' ') & "Pragma_" & Break (",)") * Name1; | |
100 | ||
101 | type Header_Symbol_Counter is array (Header_Symbol) of Natural; | |
102 | Header_Counter : Header_Symbol_Counter := (0, 0, 0, 0); | |
103 | ||
104 | Header_Current_Symbol : Header_Symbol := None; | |
105 | Header_Pending_Line : VString := Nul; | |
106 | ||
107 | ------------------------ | |
108 | -- Output_Header_Line -- | |
109 | ------------------------ | |
110 | ||
111 | procedure Output_Header_Line (S : Header_Symbol) is | |
112 | begin | |
113 | -- Skip all the #define for S-prefixed symbols in the header. | |
114 | -- Of course we are making implicit assumptions: | |
115 | -- (1) No newline between symbols with the same prefix. | |
116 | -- (2) Prefix order is the same as in snames.ads. | |
117 | ||
118 | if Header_Current_Symbol /= S then | |
119 | declare | |
120 | Pat : String := "#define " & Header_Prefix (S).all; | |
121 | In_Pat : Boolean := False; | |
122 | ||
123 | begin | |
124 | if Header_Current_Symbol /= None then | |
125 | Put_Line (OutH, Header_Pending_Line); | |
126 | end if; | |
127 | ||
128 | loop | |
129 | Line := Get_Line (InH); | |
130 | ||
131 | if Match (Line, Pat) then | |
132 | In_Pat := true; | |
133 | elsif In_Pat then | |
134 | Header_Pending_Line := Line; | |
135 | exit; | |
136 | else | |
137 | Put_Line (OutH, Line); | |
138 | end if; | |
139 | end loop; | |
140 | ||
141 | Header_Current_Symbol := S; | |
142 | end; | |
143 | end if; | |
144 | ||
145 | -- Now output the line | |
146 | ||
147 | Put_Line (OutH, "#define " & Header_Prefix (S).all | |
148 | & "_" & Name1 & (30 - Length (Name1)) * ' ' | |
149 | & Header_Counter (S)); | |
150 | Header_Counter (S) := Header_Counter (S) + 1; | |
151 | end Output_Header_Line; | |
152 | ||
153 | -- Start of processing for XSnames | |
154 | ||
589f1edf GB |
155 | begin |
156 | Open (InB, In_File, "snames.adb"); | |
157 | Open (InS, In_File, "snames.ads"); | |
84fdd8a3 | 158 | Open (InH, In_File, "snames.h"); |
589f1edf GB |
159 | |
160 | Create (OutS, Out_File, "snames.ns"); | |
161 | Create (OutB, Out_File, "snames.nb"); | |
84fdd8a3 | 162 | Create (OutH, Out_File, "snames.nh"); |
589f1edf GB |
163 | |
164 | Anchored_Mode := True; | |
165 | Oname := Nul; | |
166 | Val := 0; | |
167 | ||
589f1edf GB |
168 | loop |
169 | Line := Get_Line (InB); | |
170 | exit when Match (Line, " Preset_Names"); | |
171 | Put_Line (OutB, Line); | |
172 | end loop; | |
173 | ||
174 | Put_Line (OutB, Line); | |
175 | ||
176 | LoopN : while not End_Of_File (InS) loop | |
177 | Line := Get_Line (InS); | |
178 | ||
179 | if not Match (Line, Name_Ref) then | |
180 | Put_Line (OutS, Line); | |
181 | ||
84fdd8a3 AC |
182 | if Match (Line, Get_Attr) then |
183 | Output_Header_Line (Attr); | |
184 | elsif Match (Line, Get_Conv) then | |
185 | Output_Header_Line (Conv); | |
186 | elsif Match (Line, Get_Prag) then | |
187 | Output_Header_Line (Prag); | |
188 | end if; | |
589f1edf GB |
189 | else |
190 | Oval := Lpad (V (Val), 3, '0'); | |
191 | ||
192 | if Match (Name, "Last_") then | |
193 | Oval := Lpad (V (Val - 1), 3, '0'); | |
194 | end if; | |
195 | ||
196 | Put_Line | |
197 | (OutS, A & Name & B & ": constant Name_Id := N + " | |
198 | & Oval & ';' & Restl); | |
199 | ||
200 | if Match (Name, Get_Name) then | |
201 | Name := Name1; | |
202 | Val := Val + 1; | |
203 | ||
204 | if Match (Name, Findu, M) then | |
205 | Replace (M, Translate (A, Xlate_U_Und)); | |
206 | Translate (Name, Lower_Case_Map); | |
207 | ||
208 | elsif not Match (Name, "Op_", "") then | |
209 | Translate (Name, Lower_Case_Map); | |
210 | ||
211 | else | |
212 | Name := 'O' & Translate (Name, Lower_Case_Map); | |
213 | end if; | |
214 | ||
215 | if Name = "error" then | |
216 | Name := V ("<error>"); | |
217 | end if; | |
218 | ||
219 | if not Match (Name, Chk_Low) then | |
220 | Put_Line (OutB, " """ & Name & "#"" &"); | |
221 | end if; | |
222 | end if; | |
223 | end if; | |
224 | end loop LoopN; | |
225 | ||
226 | loop | |
227 | Line := Get_Line (InB); | |
448f2610 | 228 | exit when Match (Line, " ""#"";"); |
589f1edf GB |
229 | end loop; |
230 | ||
231 | Put_Line (OutB, Line); | |
232 | ||
233 | while not End_Of_File (InB) loop | |
84fdd8a3 AC |
234 | Line := Get_Line (InB); |
235 | Put_Line (OutB, Line); | |
236 | end loop; | |
237 | ||
238 | Put_Line (OutH, Header_Pending_Line); | |
239 | while not End_Of_File (InH) loop | |
240 | Line := Get_Line (InH); | |
241 | Put_Line (OutH, Line); | |
589f1edf | 242 | end loop; |
589f1edf | 243 | end XSnames; |