1 ------------------------------------------------------------------------------
3 -- GNAT SYSTEM UTILITIES --
9 -- Copyright (C) 1992-2007, 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 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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 -- Program to construct the spec and body of the Nmake package
30 -- sinfo.ads Spec of Sinfo package
31 -- nmake.adt Template for Nmake package
35 -- nmake.ads Spec of Nmake package
36 -- nmake.adb Body of Nmake package
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.
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.
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.
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
;
55 with Ada
.Streams
.Stream_IO
; use Ada
.Streams
.Stream_IO
;
56 with Ada
.Text_IO
; use Ada
.Text_IO
;
58 with GNAT
.Spitbol
; use GNAT
.Spitbol
;
59 with GNAT
.Spitbol
.Patterns
; use GNAT
.Spitbol
.Patterns
;
64 -- Raised to terminate execution
68 Arg_List
: VString
:= Nul
;
69 Comment
: VString
:= Nul
;
70 Default
: VString
:= Nul
;
71 Field
: VString
:= Nul
;
72 Line
: VString
:= Nul
;
73 Node
: VString
:= Nul
;
74 Op_Name
: VString
:= Nul
;
75 Prevl
: VString
:= Nul
;
76 Synonym
: VString
:= Nul
;
81 FileS
: VString
:= V
("nmake.ads");
82 FileB
: VString
:= V
("nmake.adb");
83 -- Set to null if corresponding file not to be generated
85 Given_File
: VString
:= Nul
;
86 -- File name given by command line argument
88 subtype Sfile
is Ada
.Streams
.Stream_IO
.File_Type
;
90 InS
, InT
: Ada
.Text_IO
.File_Type
;
93 wsp
: constant Pattern
:= Span
(' ' & ASCII
.HT
);
95 Body_Only
: constant Pattern
:= BreakX
(' ') * X
96 & Span
(' ') & "-- body only";
97 Spec_Only
: constant Pattern
:= BreakX
(' ') * X
98 & Span
(' ') & "-- spec only";
100 Node_Hdr
: constant Pattern
:= wsp
& "-- N_" & Rest
* Node
;
101 Punc
: constant Pattern
:= BreakX
(" .,");
103 Binop
: constant Pattern
:= wsp
104 & "-- plus fields for binary operator";
105 Unop
: constant Pattern
:= wsp
106 & "-- plus fields for unary operator";
107 Syn
: constant Pattern
:= wsp
& "-- " & Break
(' ') * Synonym
108 & " (" & Break
(')') * Field
111 Templ
: constant Pattern
:= BreakX
('T') * A
& "T e m p l a t e";
112 Spec
: constant Pattern
:= BreakX
('S') * A
& "S p e c";
114 Sem_Field
: constant Pattern
:= BreakX
('-') & "-Sem";
115 Lib_Field
: constant Pattern
:= BreakX
('-') & "-Lib";
117 Get_Field
: constant Pattern
:= BreakX
(Decimal_Digit_Set
) * Field
;
119 Get_Dflt
: constant Pattern
:= BreakX
('(') & "(set to "
120 & Break
(" ") * Default
& " if";
122 Next_Arg
: constant Pattern
:= Break
(',') * Arg
& ',';
124 Op_Node
: constant Pattern
:= "Op_" & Rest
* Op_Name
;
126 Shft_Rot
: constant Pattern
:= "Shift_" or "Rotate_";
128 No_Ent
: constant Pattern
:= "Or_Else" or "And_Then"
133 V_String_Id
: constant VString
:= V
("String_Id");
134 V_Node_Id
: constant VString
:= V
("Node_Id");
135 V_Name_Id
: constant VString
:= V
("Name_Id");
136 V_List_Id
: constant VString
:= V
("List_Id");
137 V_Elist_Id
: constant VString
:= V
("Elist_Id");
138 V_Boolean
: constant VString
:= V
("Boolean");
140 procedure Put_Line
(F
: Sfile
; S
: String);
141 procedure Put_Line
(F
: Sfile
; S
: VString
);
142 -- Local version of Put_Line ensures Unix style line endings
144 procedure WriteS
(S
: String);
145 procedure WriteB
(S
: String);
146 procedure WriteBS
(S
: String);
147 procedure WriteS
(S
: VString
);
148 procedure WriteB
(S
: VString
);
149 procedure WriteBS
(S
: VString
);
150 -- Write given line to spec or body file or both if active
152 procedure WriteB
(S
: String) is
159 procedure WriteB
(S
: VString
) is
166 procedure WriteBS
(S
: String) is
177 procedure WriteBS
(S
: VString
) is
188 procedure WriteS
(S
: String) is
195 procedure WriteS
(S
: VString
) is
202 procedure Put_Line
(F
: Sfile
; S
: String) is
204 String'Write (Stream
(F
), S
);
205 Character'Write (Stream
(F
), ASCII
.LF
);
208 procedure Put_Line
(F
: Sfile
; S
: VString
) is
210 Put_Line
(F
, To_String
(S
));
213 -- Start of processing for XNmake
217 Anchored_Mode
:= True;
219 for ArgN
in 1 .. Argument_Count
loop
221 Arg
: constant String := Argument
(ArgN
);
224 if Arg
(1) = '-' then
226 and then (Arg
(2) = 'b' or else Arg
(2) = 'B')
231 and then (Arg
(2) = 's' or else Arg
(2) = 'S')
240 if Given_File
/= Nul
then
243 Given_File
:= V
(Arg
);
249 if FileS
= Nul
and then FileB
= Nul
then
252 elsif Given_File
/= Nul
then
256 elsif FileS
= Nul
then
264 Open
(InS
, In_File
, "sinfo.ads");
265 Open
(InT
, In_File
, "nmake.adt");
268 Create
(OutS
, Out_File
, S
(FileS
));
272 Create
(OutB
, Out_File
, S
(FileB
));
275 Anchored_Mode
:= True;
277 -- Copy initial part of template to spec and body
280 Line
:= Get_Line
(InT
);
282 -- Skip lines describing the template
284 if Match
(Line
, "-- This file is a template") then
286 Line
:= Get_Line
(InT
);
291 -- Loop keeps going until "package" keyword written
293 exit when Match
(Line
, "package");
295 -- Deal with WITH lines, writing to body or spec as appropriate
297 if Match
(Line
, Body_Only
, M
) then
301 elsif Match
(Line
, Spec_Only
, M
) then
305 -- Change header from Template to Spec and write to spec file
308 if Match
(Line
, Templ
, M
) then
309 Replace
(M
, A
& " S p e c ");
314 -- Write header line to body file
316 if Match
(Line
, Spec
, M
) then
317 Replace
(M
, A
& "B o d y");
324 -- Package line reached
326 WriteS
("package Nmake is");
327 WriteB
("package body Nmake is");
330 -- Copy rest of lines up to template insert point to spec only
333 Line
:= Get_Line
(InT
);
334 exit when Match
(Line
, "!!TEMPLATE INSERTION POINT");
338 -- Here we are doing the actual insertions, loop through node types
341 Line
:= Get_Line
(InS
);
343 if Match
(Line
, Node_Hdr
)
344 and then not Match
(Node
, Punc
)
345 and then Node
/= "Unused"
347 exit when Node
= "Empty";
348 Prevl
:= " function Make_" & Node
& " (Sloc : Source_Ptr";
351 -- Loop through fields of one node
354 Line
:= Get_Line
(InS
);
357 if Match
(Line
, Binop
) then
358 WriteBS
(Prevl
& ';');
359 Append
(Arg_List
, "Left_Opnd,Right_Opnd,");
361 " " & Rpad
("Left_Opnd", NWidth
) & " : Node_Id;");
363 " " & Rpad
("Right_Opnd", NWidth
) & " : Node_Id";
365 elsif Match
(Line
, Unop
) then
366 WriteBS
(Prevl
& ';');
367 Append
(Arg_List
, "Right_Opnd,");
368 Prevl
:= " " & Rpad
("Right_Opnd", NWidth
) & " : Node_Id";
370 elsif Match
(Line
, Syn
) then
371 if Synonym
/= "Prev_Ids"
372 and then Synonym
/= "More_Ids"
373 and then Synonym
/= "Comes_From_Source"
374 and then Synonym
/= "Paren_Count"
375 and then not Match
(Field
, Sem_Field
)
376 and then not Match
(Field
, Lib_Field
)
378 Match
(Field
, Get_Field
);
380 if Field
= "Str" then
381 Field
:= V_String_Id
;
382 elsif Field
= "Node" then
384 elsif Field
= "Name" then
386 elsif Field
= "List" then
388 elsif Field
= "Elist" then
390 elsif Field
= "Flag" then
394 if Field
= "Boolean" then
395 Default
:= V
("False");
400 Match
(Comment
, Get_Dflt
);
402 WriteBS
(Prevl
& ';');
403 Append
(Arg_List
, Synonym
& ',');
404 Rpad
(Synonym
, NWidth
);
407 Prevl
:= " " & Synonym
& " : " & Field
;
410 " " & Synonym
& " : " & Field
& " := " & Default
;
416 WriteBS
(Prevl
& ')');
417 WriteS
(" return Node_Id;");
418 WriteS
(" pragma Inline (Make_" & Node
& ");");
419 WriteB
(" return Node_Id");
421 WriteB
(" N : constant Node_Id :=");
423 if Match
(Node
, "Defining_Identifier") or else
424 Match
(Node
, "Defining_Character") or else
425 Match
(Node
, "Defining_Operator")
427 WriteB
(" New_Entity (N_" & Node
& ", Sloc);");
429 WriteB
(" New_Node (N_" & Node
& ", Sloc);");
434 while Match
(Arg_List
, Next_Arg
, "") loop
435 if Length
(Arg
) < NWidth
then
436 WriteB
(" Set_" & Arg
& " (N, " & Arg
& ");");
438 WriteB
(" Set_" & Arg
);
439 WriteB
(" (N, " & Arg
& ");");
443 if Match
(Node
, Op_Node
) then
444 if Node
= "Op_Plus" then
445 WriteB
(" Set_Chars (N, Name_Op_Add);");
447 elsif Node
= "Op_Minus" then
448 WriteB
(" Set_Chars (N, Name_Op_Subtract);");
450 elsif Match
(Op_Name
, Shft_Rot
) then
451 WriteB
(" Set_Chars (N, Name_" & Op_Name
& ");");
454 WriteB
(" Set_Chars (N, Name_" & Node
& ");");
457 if not Match
(Op_Name
, No_Ent
) then
458 WriteB
(" Set_Entity (N, Standard_" & Node
& ");");
462 WriteB
(" return N;");
463 WriteB
(" end Make_" & Node
& ';');
468 WriteBS
("end Nmake;");
473 Put_Line
(Standard_Error
, "usage: xnmake [-b] [-s] [filename]");