]>
Commit | Line | Data |
---|---|---|
415dddc8 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT SYSTEM UTILITIES -- | |
4 | -- -- | |
5 | -- X N M A K E -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
4b490c1e | 9 | -- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- |
415dddc8 RK |
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- -- |
415dddc8 RK |
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. -- | |
415dddc8 RK |
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. -- |
415dddc8 RK |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
26 | -- Program to construct the spec and body of the Nmake package | |
27 | ||
28 | -- Input files: | |
29 | ||
30 | -- sinfo.ads Spec of Sinfo package | |
31 | -- nmake.adt Template for Nmake package | |
32 | ||
33 | -- Output files: | |
34 | ||
35 | -- nmake.ads Spec of Nmake package | |
36 | -- nmake.adb Body of Nmake package | |
37 | ||
38 | -- Note: this program assumes that sinfo.ads has passed the error checks that | |
39 | -- are carried out by the csinfo utility, so it does not duplicate these | |
40 | -- checks and assumes that sinfo.ads has the correct form. | |
41 | ||
42 | -- In the absence of any switches, both the ads and adb files are output. | |
43 | -- The switch -s or /s indicates that only the ads file is to be output. | |
44 | -- The switch -b or /b indicates that only the adb file is to be output. | |
45 | ||
46 | -- If a file name argument is given, then the output is written to this file | |
47 | -- rather than to nmake.ads or nmake.adb. A file name can only be given if | |
48 | -- exactly one of the -s or -b options is present. | |
49 | ||
50 | with Ada.Command_Line; use Ada.Command_Line; | |
51 | with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; | |
52 | with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; | |
53 | with Ada.Strings.Maps; use Ada.Strings.Maps; | |
54 | with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; | |
077f6c59 | 55 | with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; |
415dddc8 RK |
56 | with Ada.Text_IO; use Ada.Text_IO; |
57 | ||
58 | with GNAT.Spitbol; use GNAT.Spitbol; | |
59 | with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; | |
60 | ||
3d7b4658 TQ |
61 | with XUtil; |
62 | ||
415dddc8 RK |
63 | procedure XNmake is |
64 | ||
65 | Err : exception; | |
66 | -- Raised to terminate execution | |
67 | ||
34a343e6 RD |
68 | A : VString := Nul; |
69 | Arg : VString := Nul; | |
70 | Arg_List : VString := Nul; | |
71 | Comment : VString := Nul; | |
72 | Default : VString := Nul; | |
73 | Field : VString := Nul; | |
74 | Line : VString := Nul; | |
75 | Node : VString := Nul; | |
76 | Op_Name : VString := Nul; | |
77 | Prevl : VString := Nul; | |
78 | Synonym : VString := Nul; | |
79 | X : VString := Nul; | |
415dddc8 | 80 | |
415dddc8 RK |
81 | NWidth : Natural; |
82 | ||
83 | FileS : VString := V ("nmake.ads"); | |
84 | FileB : VString := V ("nmake.adb"); | |
85 | -- Set to null if corresponding file not to be generated | |
86 | ||
87 | Given_File : VString := Nul; | |
88 | -- File name given by command line argument | |
89 | ||
077f6c59 | 90 | subtype Sfile is Ada.Streams.Stream_IO.File_Type; |
415dddc8 | 91 | |
077f6c59 RD |
92 | InS, InT : Ada.Text_IO.File_Type; |
93 | OutS, OutB : Sfile; | |
94 | ||
34a343e6 | 95 | wsp : constant Pattern := Span (' ' & ASCII.HT); |
415dddc8 | 96 | |
34a343e6 RD |
97 | Body_Only : constant Pattern := BreakX (' ') * X |
98 | & Span (' ') & "-- body only"; | |
99 | Spec_Only : constant Pattern := BreakX (' ') * X | |
100 | & Span (' ') & "-- spec only"; | |
415dddc8 | 101 | |
34a343e6 RD |
102 | Node_Hdr : constant Pattern := wsp & "-- N_" & Rest * Node; |
103 | Punc : constant Pattern := BreakX (" .,"); | |
415dddc8 | 104 | |
34a343e6 RD |
105 | Binop : constant Pattern := wsp |
106 | & "-- plus fields for binary operator"; | |
107 | Unop : constant Pattern := wsp | |
108 | & "-- plus fields for unary operator"; | |
109 | Syn : constant Pattern := wsp & "-- " & Break (' ') * Synonym | |
110 | & " (" & Break (')') * Field | |
111 | & Rest * Comment; | |
415dddc8 | 112 | |
34a343e6 RD |
113 | Templ : constant Pattern := BreakX ('T') * A & "T e m p l a t e"; |
114 | Spec : constant Pattern := BreakX ('S') * A & "S p e c"; | |
415dddc8 | 115 | |
34a343e6 RD |
116 | Sem_Field : constant Pattern := BreakX ('-') & "-Sem"; |
117 | Lib_Field : constant Pattern := BreakX ('-') & "-Lib"; | |
415dddc8 | 118 | |
34a343e6 | 119 | Get_Field : constant Pattern := BreakX (Decimal_Digit_Set) * Field; |
415dddc8 | 120 | |
34a343e6 RD |
121 | Get_Dflt : constant Pattern := BreakX ('(') & "(set to " |
122 | & Break (" ") * Default & " if"; | |
415dddc8 | 123 | |
34a343e6 | 124 | Next_Arg : constant Pattern := Break (',') * Arg & ','; |
415dddc8 | 125 | |
34a343e6 | 126 | Op_Node : constant Pattern := "Op_" & Rest * Op_Name; |
415dddc8 | 127 | |
34a343e6 | 128 | Shft_Rot : constant Pattern := "Shift_" or "Rotate_"; |
415dddc8 | 129 | |
34a343e6 RD |
130 | No_Ent : constant Pattern := "Or_Else" or "And_Then" |
131 | or "In" or "Not_In"; | |
415dddc8 RK |
132 | |
133 | M : Match_Result; | |
134 | ||
135 | V_String_Id : constant VString := V ("String_Id"); | |
136 | V_Node_Id : constant VString := V ("Node_Id"); | |
137 | V_Name_Id : constant VString := V ("Name_Id"); | |
138 | V_List_Id : constant VString := V ("List_Id"); | |
139 | V_Elist_Id : constant VString := V ("Elist_Id"); | |
140 | V_Boolean : constant VString := V ("Boolean"); | |
141 | ||
3d7b4658 TQ |
142 | procedure Put_Line (F : Sfile; S : String) renames XUtil.Put_Line; |
143 | procedure Put_Line (F : Sfile; S : VString) renames XUtil.Put_Line; | |
077f6c59 RD |
144 | -- Local version of Put_Line ensures Unix style line endings |
145 | ||
415dddc8 RK |
146 | procedure WriteS (S : String); |
147 | procedure WriteB (S : String); | |
148 | procedure WriteBS (S : String); | |
149 | procedure WriteS (S : VString); | |
150 | procedure WriteB (S : VString); | |
151 | procedure WriteBS (S : VString); | |
152 | -- Write given line to spec or body file or both if active | |
153 | ||
154 | procedure WriteB (S : String) is | |
155 | begin | |
156 | if FileB /= Nul then | |
157 | Put_Line (OutB, S); | |
158 | end if; | |
159 | end WriteB; | |
160 | ||
161 | procedure WriteB (S : VString) is | |
162 | begin | |
163 | if FileB /= Nul then | |
164 | Put_Line (OutB, S); | |
165 | end if; | |
166 | end WriteB; | |
167 | ||
168 | procedure WriteBS (S : String) is | |
169 | begin | |
170 | if FileB /= Nul then | |
171 | Put_Line (OutB, S); | |
172 | end if; | |
173 | ||
174 | if FileS /= Nul then | |
175 | Put_Line (OutS, S); | |
176 | end if; | |
177 | end WriteBS; | |
178 | ||
179 | procedure WriteBS (S : VString) is | |
180 | begin | |
181 | if FileB /= Nul then | |
182 | Put_Line (OutB, S); | |
183 | end if; | |
184 | ||
185 | if FileS /= Nul then | |
186 | Put_Line (OutS, S); | |
187 | end if; | |
188 | end WriteBS; | |
189 | ||
190 | procedure WriteS (S : String) is | |
191 | begin | |
192 | if FileS /= Nul then | |
193 | Put_Line (OutS, S); | |
194 | end if; | |
195 | end WriteS; | |
196 | ||
197 | procedure WriteS (S : VString) is | |
198 | begin | |
199 | if FileS /= Nul then | |
200 | Put_Line (OutS, S); | |
201 | end if; | |
202 | end WriteS; | |
203 | ||
204 | -- Start of processing for XNmake | |
205 | ||
206 | begin | |
415dddc8 RK |
207 | NWidth := 28; |
208 | Anchored_Mode := True; | |
209 | ||
210 | for ArgN in 1 .. Argument_Count loop | |
211 | declare | |
212 | Arg : constant String := Argument (ArgN); | |
213 | ||
214 | begin | |
1724557a | 215 | if Arg (1) = '-' then |
415dddc8 RK |
216 | if Arg'Length = 2 |
217 | and then (Arg (2) = 'b' or else Arg (2) = 'B') | |
218 | then | |
219 | FileS := Nul; | |
220 | ||
221 | elsif Arg'Length = 2 | |
222 | and then (Arg (2) = 's' or else Arg (2) = 'S') | |
223 | then | |
224 | FileB := Nul; | |
225 | ||
226 | else | |
227 | raise Err; | |
228 | end if; | |
229 | ||
230 | else | |
231 | if Given_File /= Nul then | |
232 | raise Err; | |
233 | else | |
234 | Given_File := V (Arg); | |
235 | end if; | |
236 | end if; | |
237 | end; | |
238 | end loop; | |
239 | ||
240 | if FileS = Nul and then FileB = Nul then | |
241 | raise Err; | |
242 | ||
243 | elsif Given_File /= Nul then | |
1724557a | 244 | if FileB = Nul then |
415dddc8 RK |
245 | FileS := Given_File; |
246 | ||
1724557a | 247 | elsif FileS = Nul then |
415dddc8 RK |
248 | FileB := Given_File; |
249 | ||
250 | else | |
251 | raise Err; | |
252 | end if; | |
253 | end if; | |
254 | ||
255 | Open (InS, In_File, "sinfo.ads"); | |
256 | Open (InT, In_File, "nmake.adt"); | |
257 | ||
258 | if FileS /= Nul then | |
259 | Create (OutS, Out_File, S (FileS)); | |
260 | end if; | |
261 | ||
262 | if FileB /= Nul then | |
263 | Create (OutB, Out_File, S (FileB)); | |
264 | end if; | |
265 | ||
266 | Anchored_Mode := True; | |
267 | ||
415dddc8 RK |
268 | -- Copy initial part of template to spec and body |
269 | ||
270 | loop | |
271 | Line := Get_Line (InT); | |
272 | ||
6cbcc541 | 273 | -- Skip lines describing the template |
415dddc8 | 274 | |
6cbcc541 GK |
275 | if Match (Line, "-- This file is a template") then |
276 | loop | |
277 | Line := Get_Line (InT); | |
278 | exit when Line = ""; | |
279 | end loop; | |
280 | end if; | |
415dddc8 | 281 | |
84fdd8a3 AC |
282 | -- Loop keeps going until "package" keyword written |
283 | ||
6cbcc541 | 284 | exit when Match (Line, "package"); |
415dddc8 | 285 | |
84fdd8a3 AC |
286 | -- Deal with WITH lines, writing to body or spec as appropriate |
287 | ||
6cbcc541 GK |
288 | if Match (Line, Body_Only, M) then |
289 | Replace (M, X); | |
290 | WriteB (Line); | |
415dddc8 | 291 | |
6cbcc541 GK |
292 | elsif Match (Line, Spec_Only, M) then |
293 | Replace (M, X); | |
294 | WriteS (Line); | |
415dddc8 | 295 | |
84fdd8a3 AC |
296 | -- Change header from Template to Spec and write to spec file |
297 | ||
6cbcc541 GK |
298 | else |
299 | if Match (Line, Templ, M) then | |
300 | Replace (M, A & " S p e c "); | |
301 | end if; | |
415dddc8 | 302 | |
6cbcc541 | 303 | WriteS (Line); |
415dddc8 | 304 | |
84fdd8a3 AC |
305 | -- Write header line to body file |
306 | ||
6cbcc541 GK |
307 | if Match (Line, Spec, M) then |
308 | Replace (M, A & "B o d y"); | |
415dddc8 | 309 | end if; |
6cbcc541 GK |
310 | |
311 | WriteB (Line); | |
415dddc8 RK |
312 | end if; |
313 | end loop; | |
314 | ||
315 | -- Package line reached | |
316 | ||
317 | WriteS ("package Nmake is"); | |
318 | WriteB ("package body Nmake is"); | |
319 | WriteB (""); | |
320 | ||
321 | -- Copy rest of lines up to template insert point to spec only | |
322 | ||
323 | loop | |
324 | Line := Get_Line (InT); | |
325 | exit when Match (Line, "!!TEMPLATE INSERTION POINT"); | |
326 | WriteS (Line); | |
327 | end loop; | |
328 | ||
329 | -- Here we are doing the actual insertions, loop through node types | |
330 | ||
331 | loop | |
332 | Line := Get_Line (InS); | |
333 | ||
334 | if Match (Line, Node_Hdr) | |
335 | and then not Match (Node, Punc) | |
336 | and then Node /= "Unused" | |
337 | then | |
338 | exit when Node = "Empty"; | |
339 | Prevl := " function Make_" & Node & " (Sloc : Source_Ptr"; | |
340 | Arg_List := Nul; | |
341 | ||
342 | -- Loop through fields of one node | |
343 | ||
344 | loop | |
345 | Line := Get_Line (InS); | |
346 | exit when Line = ""; | |
347 | ||
348 | if Match (Line, Binop) then | |
349 | WriteBS (Prevl & ';'); | |
350 | Append (Arg_List, "Left_Opnd,Right_Opnd,"); | |
351 | WriteBS ( | |
352 | " " & Rpad ("Left_Opnd", NWidth) & " : Node_Id;"); | |
353 | Prevl := | |
354 | " " & Rpad ("Right_Opnd", NWidth) & " : Node_Id"; | |
355 | ||
356 | elsif Match (Line, Unop) then | |
357 | WriteBS (Prevl & ';'); | |
358 | Append (Arg_List, "Right_Opnd,"); | |
359 | Prevl := " " & Rpad ("Right_Opnd", NWidth) & " : Node_Id"; | |
360 | ||
361 | elsif Match (Line, Syn) then | |
362 | if Synonym /= "Prev_Ids" | |
363 | and then Synonym /= "More_Ids" | |
364 | and then Synonym /= "Comes_From_Source" | |
365 | and then Synonym /= "Paren_Count" | |
366 | and then not Match (Field, Sem_Field) | |
367 | and then not Match (Field, Lib_Field) | |
368 | then | |
369 | Match (Field, Get_Field); | |
370 | ||
835d23b2 RD |
371 | if Field = "Str" then |
372 | Field := V_String_Id; | |
373 | elsif Field = "Node" then | |
374 | Field := V_Node_Id; | |
375 | elsif Field = "Name" then | |
376 | Field := V_Name_Id; | |
377 | elsif Field = "List" then | |
378 | Field := V_List_Id; | |
379 | elsif Field = "Elist" then | |
380 | Field := V_Elist_Id; | |
381 | elsif Field = "Flag" then | |
382 | Field := V_Boolean; | |
415dddc8 RK |
383 | end if; |
384 | ||
385 | if Field = "Boolean" then | |
386 | Default := V ("False"); | |
387 | else | |
388 | Default := Nul; | |
389 | end if; | |
390 | ||
391 | Match (Comment, Get_Dflt); | |
392 | ||
393 | WriteBS (Prevl & ';'); | |
394 | Append (Arg_List, Synonym & ','); | |
395 | Rpad (Synonym, NWidth); | |
396 | ||
397 | if Default = "" then | |
398 | Prevl := " " & Synonym & " : " & Field; | |
399 | else | |
400 | Prevl := | |
401 | " " & Synonym & " : " & Field & " := " & Default; | |
402 | end if; | |
403 | end if; | |
404 | end if; | |
405 | end loop; | |
406 | ||
407 | WriteBS (Prevl & ')'); | |
408 | WriteS (" return Node_Id;"); | |
409 | WriteS (" pragma Inline (Make_" & Node & ");"); | |
410 | WriteB (" return Node_Id"); | |
411 | WriteB (" is"); | |
412 | WriteB (" N : constant Node_Id :="); | |
413 | ||
414 | if Match (Node, "Defining_Identifier") or else | |
415 | Match (Node, "Defining_Character") or else | |
416 | Match (Node, "Defining_Operator") | |
417 | then | |
418 | WriteB (" New_Entity (N_" & Node & ", Sloc);"); | |
419 | else | |
420 | WriteB (" New_Node (N_" & Node & ", Sloc);"); | |
421 | end if; | |
422 | ||
423 | WriteB (" begin"); | |
424 | ||
425 | while Match (Arg_List, Next_Arg, "") loop | |
426 | if Length (Arg) < NWidth then | |
427 | WriteB (" Set_" & Arg & " (N, " & Arg & ");"); | |
428 | else | |
429 | WriteB (" Set_" & Arg); | |
430 | WriteB (" (N, " & Arg & ");"); | |
431 | end if; | |
432 | end loop; | |
433 | ||
434 | if Match (Node, Op_Node) then | |
435 | if Node = "Op_Plus" then | |
436 | WriteB (" Set_Chars (N, Name_Op_Add);"); | |
437 | ||
438 | elsif Node = "Op_Minus" then | |
439 | WriteB (" Set_Chars (N, Name_Op_Subtract);"); | |
440 | ||
441 | elsif Match (Op_Name, Shft_Rot) then | |
442 | WriteB (" Set_Chars (N, Name_" & Op_Name & ");"); | |
443 | ||
444 | else | |
445 | WriteB (" Set_Chars (N, Name_" & Node & ");"); | |
446 | end if; | |
447 | ||
448 | if not Match (Op_Name, No_Ent) then | |
449 | WriteB (" Set_Entity (N, Standard_" & Node & ");"); | |
450 | end if; | |
451 | end if; | |
452 | ||
453 | WriteB (" return N;"); | |
454 | WriteB (" end Make_" & Node & ';'); | |
455 | WriteBS (""); | |
456 | end if; | |
457 | end loop; | |
458 | ||
459 | WriteBS ("end Nmake;"); | |
460 | ||
461 | exception | |
462 | ||
463 | when Err => | |
464 | Put_Line (Standard_Error, "usage: xnmake [-b] [-s] [filename]"); | |
465 | Set_Exit_Status (1); | |
466 | ||
467 | end XNmake; |