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
: Pattern
:= Span
(' ' & ASCII
.HT
);
95 Body_Only
: Pattern
:= BreakX
(' ') * X
& Span
(' ') & "-- body only";
96 Spec_Only
: Pattern
:= BreakX
(' ') * X
& Span
(' ') & "-- spec only";
98 Node_Hdr
: Pattern
:= wsp
& "-- N_" & Rest
* Node
;
99 Punc
: Pattern
:= BreakX
(" .,");
101 Binop
: Pattern
:= wsp
& "-- plus fields for binary operator";
102 Unop
: Pattern
:= wsp
& "-- plus fields for unary operator";
103 Syn
: Pattern
:= wsp
& "-- " & Break
(' ') * Synonym
104 & " (" & Break
(')') * Field
& Rest
* Comment
;
106 Templ
: Pattern
:= BreakX
('T') * A
& "T e m p l a t e";
107 Spec
: Pattern
:= BreakX
('S') * A
& "S p e c";
109 Sem_Field
: Pattern
:= BreakX
('-') & "-Sem";
110 Lib_Field
: Pattern
:= BreakX
('-') & "-Lib";
112 Get_Field
: Pattern
:= BreakX
(Decimal_Digit_Set
) * Field
;
114 Get_Dflt
: Pattern
:= BreakX
('(') & "(set to "
115 & Break
(" ") * Default
& " if";
117 Next_Arg
: Pattern
:= Break
(',') * Arg
& ',';
119 Op_Node
: Pattern
:= "Op_" & Rest
* Op_Name
;
121 Shft_Rot
: Pattern
:= "Shift_" or "Rotate_";
123 No_Ent
: Pattern
:= "Or_Else" or "And_Then" or "In" or "Not_In";
127 V_String_Id
: constant VString
:= V
("String_Id");
128 V_Node_Id
: constant VString
:= V
("Node_Id");
129 V_Name_Id
: constant VString
:= V
("Name_Id");
130 V_List_Id
: constant VString
:= V
("List_Id");
131 V_Elist_Id
: constant VString
:= V
("Elist_Id");
132 V_Boolean
: constant VString
:= V
("Boolean");
134 procedure Put_Line
(F
: Sfile
; S
: String);
135 procedure Put_Line
(F
: Sfile
; S
: VString
);
136 -- Local version of Put_Line ensures Unix style line endings
138 procedure WriteS
(S
: String);
139 procedure WriteB
(S
: String);
140 procedure WriteBS
(S
: String);
141 procedure WriteS
(S
: VString
);
142 procedure WriteB
(S
: VString
);
143 procedure WriteBS
(S
: VString
);
144 -- Write given line to spec or body file or both if active
146 procedure WriteB
(S
: String) is
153 procedure WriteB
(S
: VString
) is
160 procedure WriteBS
(S
: String) is
171 procedure WriteBS
(S
: VString
) is
182 procedure WriteS
(S
: String) is
189 procedure WriteS
(S
: VString
) is
196 procedure Put_Line
(F
: Sfile
; S
: String) is
198 String'Write (Stream
(F
), S
);
199 Character'Write (Stream
(F
), ASCII
.LF
);
202 procedure Put_Line
(F
: Sfile
; S
: VString
) is
204 Put_Line
(F
, To_String
(S
));
207 -- Start of processing for XNmake
211 Anchored_Mode
:= True;
213 for ArgN
in 1 .. Argument_Count
loop
215 Arg
: constant String := Argument
(ArgN
);
218 if Arg
(1) = '-' then
220 and then (Arg
(2) = 'b' or else Arg
(2) = 'B')
225 and then (Arg
(2) = 's' or else Arg
(2) = 'S')
234 if Given_File
/= Nul
then
237 Given_File
:= V
(Arg
);
243 if FileS
= Nul
and then FileB
= Nul
then
246 elsif Given_File
/= Nul
then
250 elsif FileS
= Nul
then
258 Open
(InS
, In_File
, "sinfo.ads");
259 Open
(InT
, In_File
, "nmake.adt");
262 Create
(OutS
, Out_File
, S
(FileS
));
266 Create
(OutB
, Out_File
, S
(FileB
));
269 Anchored_Mode
:= True;
271 -- Copy initial part of template to spec and body
274 Line
:= Get_Line
(InT
);
276 -- Skip lines describing the template
278 if Match
(Line
, "-- This file is a template") then
280 Line
:= Get_Line
(InT
);
285 -- Loop keeps going until "package" keyword written
287 exit when Match
(Line
, "package");
289 -- Deal with WITH lines, writing to body or spec as appropriate
291 if Match
(Line
, Body_Only
, M
) then
295 elsif Match
(Line
, Spec_Only
, M
) then
299 -- Change header from Template to Spec and write to spec file
302 if Match
(Line
, Templ
, M
) then
303 Replace
(M
, A
& " S p e c ");
308 -- Write header line to body file
310 if Match
(Line
, Spec
, M
) then
311 Replace
(M
, A
& "B o d y");
318 -- Package line reached
320 WriteS
("package Nmake is");
321 WriteB
("package body Nmake is");
324 -- Copy rest of lines up to template insert point to spec only
327 Line
:= Get_Line
(InT
);
328 exit when Match
(Line
, "!!TEMPLATE INSERTION POINT");
332 -- Here we are doing the actual insertions, loop through node types
335 Line
:= Get_Line
(InS
);
337 if Match
(Line
, Node_Hdr
)
338 and then not Match
(Node
, Punc
)
339 and then Node
/= "Unused"
341 exit when Node
= "Empty";
342 Prevl
:= " function Make_" & Node
& " (Sloc : Source_Ptr";
345 -- Loop through fields of one node
348 Line
:= Get_Line
(InS
);
351 if Match
(Line
, Binop
) then
352 WriteBS
(Prevl
& ';');
353 Append
(Arg_List
, "Left_Opnd,Right_Opnd,");
355 " " & Rpad
("Left_Opnd", NWidth
) & " : Node_Id;");
357 " " & Rpad
("Right_Opnd", NWidth
) & " : Node_Id";
359 elsif Match
(Line
, Unop
) then
360 WriteBS
(Prevl
& ';');
361 Append
(Arg_List
, "Right_Opnd,");
362 Prevl
:= " " & Rpad
("Right_Opnd", NWidth
) & " : Node_Id";
364 elsif Match
(Line
, Syn
) then
365 if Synonym
/= "Prev_Ids"
366 and then Synonym
/= "More_Ids"
367 and then Synonym
/= "Comes_From_Source"
368 and then Synonym
/= "Paren_Count"
369 and then not Match
(Field
, Sem_Field
)
370 and then not Match
(Field
, Lib_Field
)
372 Match
(Field
, Get_Field
);
374 if Field
= "Str" then
375 Field
:= V_String_Id
;
376 elsif Field
= "Node" then
378 elsif Field
= "Name" then
380 elsif Field
= "List" then
382 elsif Field
= "Elist" then
384 elsif Field
= "Flag" then
388 if Field
= "Boolean" then
389 Default
:= V
("False");
394 Match
(Comment
, Get_Dflt
);
396 WriteBS
(Prevl
& ';');
397 Append
(Arg_List
, Synonym
& ',');
398 Rpad
(Synonym
, NWidth
);
401 Prevl
:= " " & Synonym
& " : " & Field
;
404 " " & Synonym
& " : " & Field
& " := " & Default
;
410 WriteBS
(Prevl
& ')');
411 WriteS
(" return Node_Id;");
412 WriteS
(" pragma Inline (Make_" & Node
& ");");
413 WriteB
(" return Node_Id");
415 WriteB
(" N : constant Node_Id :=");
417 if Match
(Node
, "Defining_Identifier") or else
418 Match
(Node
, "Defining_Character") or else
419 Match
(Node
, "Defining_Operator")
421 WriteB
(" New_Entity (N_" & Node
& ", Sloc);");
423 WriteB
(" New_Node (N_" & Node
& ", Sloc);");
428 while Match
(Arg_List
, Next_Arg
, "") loop
429 if Length
(Arg
) < NWidth
then
430 WriteB
(" Set_" & Arg
& " (N, " & Arg
& ");");
432 WriteB
(" Set_" & Arg
);
433 WriteB
(" (N, " & Arg
& ");");
437 if Match
(Node
, Op_Node
) then
438 if Node
= "Op_Plus" then
439 WriteB
(" Set_Chars (N, Name_Op_Add);");
441 elsif Node
= "Op_Minus" then
442 WriteB
(" Set_Chars (N, Name_Op_Subtract);");
444 elsif Match
(Op_Name
, Shft_Rot
) then
445 WriteB
(" Set_Chars (N, Name_" & Op_Name
& ");");
448 WriteB
(" Set_Chars (N, Name_" & Node
& ");");
451 if not Match
(Op_Name
, No_Ent
) then
452 WriteB
(" Set_Entity (N, Standard_" & Node
& ");");
456 WriteB
(" return N;");
457 WriteB
(" end Make_" & Node
& ';');
462 WriteBS
("end Nmake;");
467 Put_Line
(Standard_Error
, "usage: xnmake [-b] [-s] [filename]");