1 ------------------------------------------------------------------------------
3 -- GNAT SYSTEM UTILITIES --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 -- Program to construct the spec and body of the Nmake package
32 -- sinfo.ads Spec of Sinfo package
33 -- nmake.adt Template for Nmake package
37 -- nmake.ads Spec of Nmake package
38 -- nmake.adb Body of Nmake package
40 -- Note: this program assumes that sinfo.ads has passed the error checks that
41 -- are carried out by the csinfo utility, so it does not duplicate these
42 -- checks and assumes that sinfo.ads has the correct form.
44 -- In the absence of any switches, both the ads and adb files are output.
45 -- The switch -s or /s indicates that only the ads file is to be output.
46 -- The switch -b or /b indicates that only the adb file is to be output.
48 -- If a file name argument is given, then the output is written to this file
49 -- rather than to nmake.ads or nmake.adb. A file name can only be given if
50 -- exactly one of the -s or -b options is present.
52 with Ada
.Command_Line
; use Ada
.Command_Line
;
53 with Ada
.Strings
.Unbounded
; use Ada
.Strings
.Unbounded
;
54 with Ada
.Strings
.Unbounded
.Text_IO
; use Ada
.Strings
.Unbounded
.Text_IO
;
55 with Ada
.Strings
.Maps
; use Ada
.Strings
.Maps
;
56 with Ada
.Strings
.Maps
.Constants
; use Ada
.Strings
.Maps
.Constants
;
57 with Ada
.Text_IO
; use Ada
.Text_IO
;
59 with GNAT
.Spitbol
; use GNAT
.Spitbol
;
60 with GNAT
.Spitbol
.Patterns
; use GNAT
.Spitbol
.Patterns
;
65 -- Raised to terminate execution
69 Arg_List
: VString
:= Nul
;
70 Comment
: VString
:= Nul
;
71 Default
: VString
:= Nul
;
72 Field
: VString
:= Nul
;
73 Line
: VString
:= Nul
;
74 Node
: VString
:= Nul
;
75 Op_Name
: VString
:= Nul
;
76 Prevl
: VString
:= Nul
;
77 Synonym
: VString
:= Nul
;
83 FileS
: VString
:= V
("nmake.ads");
84 FileB
: VString
:= V
("nmake.adb");
85 -- Set to null if corresponding file not to be generated
87 Given_File
: VString
:= Nul
;
88 -- File name given by command line argument
91 OutS
, OutB
: File_Type
;
93 wsp
: Pattern
:= Span
(' ' & ASCII
.HT
);
95 -- Note: in following patterns, we break up the word revision to
96 -- avoid RCS getting enthusiastic about updating the reference!
98 Body_Only
: Pattern
:= BreakX
(' ') * X
& Span
(' ') & "-- body only";
99 Spec_Only
: Pattern
:= BreakX
(' ') * X
& Span
(' ') & "-- spec only";
101 Node_Hdr
: Pattern
:= wsp
& "-- N_" & Rest
* Node
;
102 Punc
: Pattern
:= BreakX
(" .,");
104 Binop
: Pattern
:= wsp
& "-- plus fields for binary operator";
105 Unop
: Pattern
:= wsp
& "-- plus fields for unary operator";
106 Syn
: Pattern
:= wsp
& "-- " & Break
(' ') * Synonym
107 & " (" & Break
(')') * Field
& Rest
* Comment
;
109 Templ
: Pattern
:= BreakX
('T') * A
& "T e m p l a t e";
110 Spec
: Pattern
:= BreakX
('S') * A
& "S p e c";
112 Sem_Field
: Pattern
:= BreakX
('-') & "-Sem";
113 Lib_Field
: Pattern
:= BreakX
('-') & "-Lib";
115 Get_Field
: Pattern
:= BreakX
(Decimal_Digit_Set
) * Field
;
117 Get_Dflt
: Pattern
:= BreakX
('(') & "(set to "
118 & Break
(" ") * Default
& " if";
120 Next_Arg
: Pattern
:= Break
(',') * Arg
& ',';
122 Op_Node
: Pattern
:= "Op_" & Rest
* Op_Name
;
124 Shft_Rot
: Pattern
:= "Shift_" or "Rotate_";
126 No_Ent
: Pattern
:= "Or_Else" or "And_Then" or "In" or "Not_In";
130 V_String_Id
: constant VString
:= V
("String_Id");
131 V_Node_Id
: constant VString
:= V
("Node_Id");
132 V_Name_Id
: constant VString
:= V
("Name_Id");
133 V_List_Id
: constant VString
:= V
("List_Id");
134 V_Elist_Id
: constant VString
:= V
("Elist_Id");
135 V_Boolean
: constant VString
:= V
("Boolean");
137 procedure WriteS
(S
: String);
138 procedure WriteB
(S
: String);
139 procedure WriteBS
(S
: String);
140 procedure WriteS
(S
: VString
);
141 procedure WriteB
(S
: VString
);
142 procedure WriteBS
(S
: VString
);
143 -- Write given line to spec or body file or both if active
145 procedure WriteB
(S
: String) is
152 procedure WriteB
(S
: VString
) is
159 procedure WriteBS
(S
: String) is
170 procedure WriteBS
(S
: VString
) is
181 procedure WriteS
(S
: String) is
188 procedure WriteS
(S
: VString
) is
195 -- Start of processing for XNmake
198 -- Capture our revision (following line updated by RCS)
202 Anchored_Mode
:= True;
204 for ArgN
in 1 .. Argument_Count
loop
206 Arg
: constant String := Argument
(ArgN
);
209 if Arg
(1) = '-' then
211 and then (Arg
(2) = 'b' or else Arg
(2) = 'B')
216 and then (Arg
(2) = 's' or else Arg
(2) = 'S')
225 if Given_File
/= Nul
then
228 Given_File
:= V
(Arg
);
234 if FileS
= Nul
and then FileB
= Nul
then
237 elsif Given_File
/= Nul
then
241 elsif FileS
= Nul
then
249 Open
(InS
, In_File
, "sinfo.ads");
250 Open
(InT
, In_File
, "nmake.adt");
253 Create
(OutS
, Out_File
, S
(FileS
));
257 Create
(OutB
, Out_File
, S
(FileB
));
260 Anchored_Mode
:= True;
262 -- Copy initial part of template to spec and body
265 Line
:= Get_Line
(InT
);
267 -- Skip lines describing the template
269 if Match
(Line
, "-- This file is a template") then
271 Line
:= Get_Line
(InT
);
276 exit when Match
(Line
, "package");
278 if Match
(Line
, Body_Only
, M
) then
282 elsif Match
(Line
, Spec_Only
, M
) then
287 if Match
(Line
, Templ
, M
) then
288 Replace
(M
, A
& " S p e c ");
293 if Match
(Line
, Spec
, M
) then
294 Replace
(M
, A
& "B o d y");
301 -- Package line reached
303 WriteS
("package Nmake is");
304 WriteB
("package body Nmake is");
307 -- Copy rest of lines up to template insert point to spec only
310 Line
:= Get_Line
(InT
);
311 exit when Match
(Line
, "!!TEMPLATE INSERTION POINT");
315 -- Here we are doing the actual insertions, loop through node types
318 Line
:= Get_Line
(InS
);
320 if Match
(Line
, Node_Hdr
)
321 and then not Match
(Node
, Punc
)
322 and then Node
/= "Unused"
324 exit when Node
= "Empty";
325 Prevl
:= " function Make_" & Node
& " (Sloc : Source_Ptr";
328 -- Loop through fields of one node
331 Line
:= Get_Line
(InS
);
334 if Match
(Line
, Binop
) then
335 WriteBS
(Prevl
& ';');
336 Append
(Arg_List
, "Left_Opnd,Right_Opnd,");
338 " " & Rpad
("Left_Opnd", NWidth
) & " : Node_Id;");
340 " " & Rpad
("Right_Opnd", NWidth
) & " : Node_Id";
342 elsif Match
(Line
, Unop
) then
343 WriteBS
(Prevl
& ';');
344 Append
(Arg_List
, "Right_Opnd,");
345 Prevl
:= " " & Rpad
("Right_Opnd", NWidth
) & " : Node_Id";
347 elsif Match
(Line
, Syn
) then
348 if Synonym
/= "Prev_Ids"
349 and then Synonym
/= "More_Ids"
350 and then Synonym
/= "Comes_From_Source"
351 and then Synonym
/= "Paren_Count"
352 and then not Match
(Field
, Sem_Field
)
353 and then not Match
(Field
, Lib_Field
)
355 Match
(Field
, Get_Field
);
357 if Field
= "Str" then Field
:= V_String_Id
;
358 elsif Field
= "Node" then Field
:= V_Node_Id
;
359 elsif Field
= "Name" then Field
:= V_Name_Id
;
360 elsif Field
= "List" then Field
:= V_List_Id
;
361 elsif Field
= "Elist" then Field
:= V_Elist_Id
;
362 elsif Field
= "Flag" then Field
:= V_Boolean
;
365 if Field
= "Boolean" then
366 Default
:= V
("False");
371 Match
(Comment
, Get_Dflt
);
373 WriteBS
(Prevl
& ';');
374 Append
(Arg_List
, Synonym
& ',');
375 Rpad
(Synonym
, NWidth
);
378 Prevl
:= " " & Synonym
& " : " & Field
;
381 " " & Synonym
& " : " & Field
& " := " & Default
;
387 WriteBS
(Prevl
& ')');
388 WriteS
(" return Node_Id;");
389 WriteS
(" pragma Inline (Make_" & Node
& ");");
390 WriteB
(" return Node_Id");
392 WriteB
(" N : constant Node_Id :=");
394 if Match
(Node
, "Defining_Identifier") or else
395 Match
(Node
, "Defining_Character") or else
396 Match
(Node
, "Defining_Operator")
398 WriteB
(" New_Entity (N_" & Node
& ", Sloc);");
400 WriteB
(" New_Node (N_" & Node
& ", Sloc);");
405 while Match
(Arg_List
, Next_Arg
, "") loop
406 if Length
(Arg
) < NWidth
then
407 WriteB
(" Set_" & Arg
& " (N, " & Arg
& ");");
409 WriteB
(" Set_" & Arg
);
410 WriteB
(" (N, " & Arg
& ");");
414 if Match
(Node
, Op_Node
) then
415 if Node
= "Op_Plus" then
416 WriteB
(" Set_Chars (N, Name_Op_Add);");
418 elsif Node
= "Op_Minus" then
419 WriteB
(" Set_Chars (N, Name_Op_Subtract);");
421 elsif Match
(Op_Name
, Shft_Rot
) then
422 WriteB
(" Set_Chars (N, Name_" & Op_Name
& ");");
425 WriteB
(" Set_Chars (N, Name_" & Node
& ");");
428 if not Match
(Op_Name
, No_Ent
) then
429 WriteB
(" Set_Entity (N, Standard_" & Node
& ");");
433 WriteB
(" return N;");
434 WriteB
(" end Make_" & Node
& ';');
439 WriteBS
("end Nmake;");
444 Put_Line
(Standard_Error
, "usage: xnmake [-b] [-s] [filename]");