------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
-- --
|
-- --
|
-- GNAT SYSTEM UTILITIES --
|
-- GNAT SYSTEM UTILITIES --
|
-- --
|
-- --
|
-- X N M A K E --
|
-- X N M A K E --
|
-- --
|
-- --
|
-- B o d y --
|
-- B o d y --
|
-- --
|
-- --
|
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
|
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
|
-- --
|
-- --
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
-- for more details. You should have received a copy of the GNU General --
|
-- for more details. You should have received a copy of the GNU General --
|
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
|
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
|
-- http://www.gnu.org/licenses for a complete copy of the license. --
|
-- http://www.gnu.org/licenses for a complete copy of the license. --
|
-- --
|
-- --
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
-- --
|
-- --
|
------------------------------------------------------------------------------
|
------------------------------------------------------------------------------
|
|
|
-- Program to construct the spec and body of the Nmake package
|
-- Program to construct the spec and body of the Nmake package
|
|
|
-- Input files:
|
-- Input files:
|
|
|
-- sinfo.ads Spec of Sinfo package
|
-- sinfo.ads Spec of Sinfo package
|
-- nmake.adt Template for Nmake package
|
-- nmake.adt Template for Nmake package
|
|
|
-- Output files:
|
-- Output files:
|
|
|
-- nmake.ads Spec of Nmake package
|
-- nmake.ads Spec of Nmake package
|
-- nmake.adb Body of Nmake package
|
-- nmake.adb Body of Nmake package
|
|
|
-- Note: this program assumes that sinfo.ads has passed the error checks that
|
-- Note: this program assumes that sinfo.ads has passed the error checks that
|
-- are carried out by the csinfo utility, so it does not duplicate these
|
-- are carried out by the csinfo utility, so it does not duplicate these
|
-- checks and assumes that sinfo.ads has the correct form.
|
-- checks and assumes that sinfo.ads has the correct form.
|
|
|
-- In the absence of any switches, both the ads and adb files are output.
|
-- In the absence of any switches, both the ads and adb files are output.
|
-- The switch -s or /s indicates that only the ads file is to be output.
|
-- The switch -s or /s indicates that only the ads file is to be output.
|
-- The switch -b or /b indicates that only the adb file is to be output.
|
-- The switch -b or /b indicates that only the adb file is to be output.
|
|
|
-- If a file name argument is given, then the output is written to this file
|
-- If a file name argument is given, then the output is written to this file
|
-- rather than to nmake.ads or nmake.adb. A file name can only be given if
|
-- rather than to nmake.ads or nmake.adb. A file name can only be given if
|
-- exactly one of the -s or -b options is present.
|
-- exactly one of the -s or -b options is present.
|
|
|
with Ada.Command_Line; use Ada.Command_Line;
|
with Ada.Command_Line; use Ada.Command_Line;
|
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
|
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
|
with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
|
with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
|
with Ada.Strings.Maps; use Ada.Strings.Maps;
|
with Ada.Strings.Maps; use Ada.Strings.Maps;
|
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
|
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
|
with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
|
with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
|
with Ada.Text_IO; use Ada.Text_IO;
|
with Ada.Text_IO; use Ada.Text_IO;
|
|
|
with GNAT.Spitbol; use GNAT.Spitbol;
|
with GNAT.Spitbol; use GNAT.Spitbol;
|
with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns;
|
with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns;
|
|
|
with XUtil;
|
with XUtil;
|
|
|
procedure XNmake is
|
procedure XNmake is
|
|
|
Err : exception;
|
Err : exception;
|
-- Raised to terminate execution
|
-- Raised to terminate execution
|
|
|
A : VString := Nul;
|
A : VString := Nul;
|
Arg : VString := Nul;
|
Arg : VString := Nul;
|
Arg_List : VString := Nul;
|
Arg_List : VString := Nul;
|
Comment : VString := Nul;
|
Comment : VString := Nul;
|
Default : VString := Nul;
|
Default : VString := Nul;
|
Field : VString := Nul;
|
Field : VString := Nul;
|
Line : VString := Nul;
|
Line : VString := Nul;
|
Node : VString := Nul;
|
Node : VString := Nul;
|
Op_Name : VString := Nul;
|
Op_Name : VString := Nul;
|
Prevl : VString := Nul;
|
Prevl : VString := Nul;
|
Synonym : VString := Nul;
|
Synonym : VString := Nul;
|
X : VString := Nul;
|
X : VString := Nul;
|
|
|
NWidth : Natural;
|
NWidth : Natural;
|
|
|
FileS : VString := V ("nmake.ads");
|
FileS : VString := V ("nmake.ads");
|
FileB : VString := V ("nmake.adb");
|
FileB : VString := V ("nmake.adb");
|
-- Set to null if corresponding file not to be generated
|
-- Set to null if corresponding file not to be generated
|
|
|
Given_File : VString := Nul;
|
Given_File : VString := Nul;
|
-- File name given by command line argument
|
-- File name given by command line argument
|
|
|
subtype Sfile is Ada.Streams.Stream_IO.File_Type;
|
subtype Sfile is Ada.Streams.Stream_IO.File_Type;
|
|
|
InS, InT : Ada.Text_IO.File_Type;
|
InS, InT : Ada.Text_IO.File_Type;
|
OutS, OutB : Sfile;
|
OutS, OutB : Sfile;
|
|
|
wsp : constant Pattern := Span (' ' & ASCII.HT);
|
wsp : constant Pattern := Span (' ' & ASCII.HT);
|
|
|
Body_Only : constant Pattern := BreakX (' ') * X
|
Body_Only : constant Pattern := BreakX (' ') * X
|
& Span (' ') & "-- body only";
|
& Span (' ') & "-- body only";
|
Spec_Only : constant Pattern := BreakX (' ') * X
|
Spec_Only : constant Pattern := BreakX (' ') * X
|
& Span (' ') & "-- spec only";
|
& Span (' ') & "-- spec only";
|
|
|
Node_Hdr : constant Pattern := wsp & "-- N_" & Rest * Node;
|
Node_Hdr : constant Pattern := wsp & "-- N_" & Rest * Node;
|
Punc : constant Pattern := BreakX (" .,");
|
Punc : constant Pattern := BreakX (" .,");
|
|
|
Binop : constant Pattern := wsp
|
Binop : constant Pattern := wsp
|
& "-- plus fields for binary operator";
|
& "-- plus fields for binary operator";
|
Unop : constant Pattern := wsp
|
Unop : constant Pattern := wsp
|
& "-- plus fields for unary operator";
|
& "-- plus fields for unary operator";
|
Syn : constant Pattern := wsp & "-- " & Break (' ') * Synonym
|
Syn : constant Pattern := wsp & "-- " & Break (' ') * Synonym
|
& " (" & Break (')') * Field
|
& " (" & Break (')') * Field
|
& Rest * Comment;
|
& Rest * Comment;
|
|
|
Templ : constant Pattern := BreakX ('T') * A & "T e m p l a t e";
|
Templ : constant Pattern := BreakX ('T') * A & "T e m p l a t e";
|
Spec : constant Pattern := BreakX ('S') * A & "S p e c";
|
Spec : constant Pattern := BreakX ('S') * A & "S p e c";
|
|
|
Sem_Field : constant Pattern := BreakX ('-') & "-Sem";
|
Sem_Field : constant Pattern := BreakX ('-') & "-Sem";
|
Lib_Field : constant Pattern := BreakX ('-') & "-Lib";
|
Lib_Field : constant Pattern := BreakX ('-') & "-Lib";
|
|
|
Get_Field : constant Pattern := BreakX (Decimal_Digit_Set) * Field;
|
Get_Field : constant Pattern := BreakX (Decimal_Digit_Set) * Field;
|
|
|
Get_Dflt : constant Pattern := BreakX ('(') & "(set to "
|
Get_Dflt : constant Pattern := BreakX ('(') & "(set to "
|
& Break (" ") * Default & " if";
|
& Break (" ") * Default & " if";
|
|
|
Next_Arg : constant Pattern := Break (',') * Arg & ',';
|
Next_Arg : constant Pattern := Break (',') * Arg & ',';
|
|
|
Op_Node : constant Pattern := "Op_" & Rest * Op_Name;
|
Op_Node : constant Pattern := "Op_" & Rest * Op_Name;
|
|
|
Shft_Rot : constant Pattern := "Shift_" or "Rotate_";
|
Shft_Rot : constant Pattern := "Shift_" or "Rotate_";
|
|
|
No_Ent : constant Pattern := "Or_Else" or "And_Then"
|
No_Ent : constant Pattern := "Or_Else" or "And_Then"
|
or "In" or "Not_In";
|
or "In" or "Not_In";
|
|
|
M : Match_Result;
|
M : Match_Result;
|
|
|
V_String_Id : constant VString := V ("String_Id");
|
V_String_Id : constant VString := V ("String_Id");
|
V_Node_Id : constant VString := V ("Node_Id");
|
V_Node_Id : constant VString := V ("Node_Id");
|
V_Name_Id : constant VString := V ("Name_Id");
|
V_Name_Id : constant VString := V ("Name_Id");
|
V_List_Id : constant VString := V ("List_Id");
|
V_List_Id : constant VString := V ("List_Id");
|
V_Elist_Id : constant VString := V ("Elist_Id");
|
V_Elist_Id : constant VString := V ("Elist_Id");
|
V_Boolean : constant VString := V ("Boolean");
|
V_Boolean : constant VString := V ("Boolean");
|
|
|
procedure Put_Line (F : Sfile; S : String) renames XUtil.Put_Line;
|
procedure Put_Line (F : Sfile; S : String) renames XUtil.Put_Line;
|
procedure Put_Line (F : Sfile; S : VString) renames XUtil.Put_Line;
|
procedure Put_Line (F : Sfile; S : VString) renames XUtil.Put_Line;
|
-- Local version of Put_Line ensures Unix style line endings
|
-- Local version of Put_Line ensures Unix style line endings
|
|
|
procedure WriteS (S : String);
|
procedure WriteS (S : String);
|
procedure WriteB (S : String);
|
procedure WriteB (S : String);
|
procedure WriteBS (S : String);
|
procedure WriteBS (S : String);
|
procedure WriteS (S : VString);
|
procedure WriteS (S : VString);
|
procedure WriteB (S : VString);
|
procedure WriteB (S : VString);
|
procedure WriteBS (S : VString);
|
procedure WriteBS (S : VString);
|
-- Write given line to spec or body file or both if active
|
-- Write given line to spec or body file or both if active
|
|
|
procedure WriteB (S : String) is
|
procedure WriteB (S : String) is
|
begin
|
begin
|
if FileB /= Nul then
|
if FileB /= Nul then
|
Put_Line (OutB, S);
|
Put_Line (OutB, S);
|
end if;
|
end if;
|
end WriteB;
|
end WriteB;
|
|
|
procedure WriteB (S : VString) is
|
procedure WriteB (S : VString) is
|
begin
|
begin
|
if FileB /= Nul then
|
if FileB /= Nul then
|
Put_Line (OutB, S);
|
Put_Line (OutB, S);
|
end if;
|
end if;
|
end WriteB;
|
end WriteB;
|
|
|
procedure WriteBS (S : String) is
|
procedure WriteBS (S : String) is
|
begin
|
begin
|
if FileB /= Nul then
|
if FileB /= Nul then
|
Put_Line (OutB, S);
|
Put_Line (OutB, S);
|
end if;
|
end if;
|
|
|
if FileS /= Nul then
|
if FileS /= Nul then
|
Put_Line (OutS, S);
|
Put_Line (OutS, S);
|
end if;
|
end if;
|
end WriteBS;
|
end WriteBS;
|
|
|
procedure WriteBS (S : VString) is
|
procedure WriteBS (S : VString) is
|
begin
|
begin
|
if FileB /= Nul then
|
if FileB /= Nul then
|
Put_Line (OutB, S);
|
Put_Line (OutB, S);
|
end if;
|
end if;
|
|
|
if FileS /= Nul then
|
if FileS /= Nul then
|
Put_Line (OutS, S);
|
Put_Line (OutS, S);
|
end if;
|
end if;
|
end WriteBS;
|
end WriteBS;
|
|
|
procedure WriteS (S : String) is
|
procedure WriteS (S : String) is
|
begin
|
begin
|
if FileS /= Nul then
|
if FileS /= Nul then
|
Put_Line (OutS, S);
|
Put_Line (OutS, S);
|
end if;
|
end if;
|
end WriteS;
|
end WriteS;
|
|
|
procedure WriteS (S : VString) is
|
procedure WriteS (S : VString) is
|
begin
|
begin
|
if FileS /= Nul then
|
if FileS /= Nul then
|
Put_Line (OutS, S);
|
Put_Line (OutS, S);
|
end if;
|
end if;
|
end WriteS;
|
end WriteS;
|
|
|
-- Start of processing for XNmake
|
-- Start of processing for XNmake
|
|
|
begin
|
begin
|
NWidth := 28;
|
NWidth := 28;
|
Anchored_Mode := True;
|
Anchored_Mode := True;
|
|
|
for ArgN in 1 .. Argument_Count loop
|
for ArgN in 1 .. Argument_Count loop
|
declare
|
declare
|
Arg : constant String := Argument (ArgN);
|
Arg : constant String := Argument (ArgN);
|
|
|
begin
|
begin
|
if Arg (1) = '-' then
|
if Arg (1) = '-' then
|
if Arg'Length = 2
|
if Arg'Length = 2
|
and then (Arg (2) = 'b' or else Arg (2) = 'B')
|
and then (Arg (2) = 'b' or else Arg (2) = 'B')
|
then
|
then
|
FileS := Nul;
|
FileS := Nul;
|
|
|
elsif Arg'Length = 2
|
elsif Arg'Length = 2
|
and then (Arg (2) = 's' or else Arg (2) = 'S')
|
and then (Arg (2) = 's' or else Arg (2) = 'S')
|
then
|
then
|
FileB := Nul;
|
FileB := Nul;
|
|
|
else
|
else
|
raise Err;
|
raise Err;
|
end if;
|
end if;
|
|
|
else
|
else
|
if Given_File /= Nul then
|
if Given_File /= Nul then
|
raise Err;
|
raise Err;
|
else
|
else
|
Given_File := V (Arg);
|
Given_File := V (Arg);
|
end if;
|
end if;
|
end if;
|
end if;
|
end;
|
end;
|
end loop;
|
end loop;
|
|
|
if FileS = Nul and then FileB = Nul then
|
if FileS = Nul and then FileB = Nul then
|
raise Err;
|
raise Err;
|
|
|
elsif Given_File /= Nul then
|
elsif Given_File /= Nul then
|
if FileB = Nul then
|
if FileB = Nul then
|
FileS := Given_File;
|
FileS := Given_File;
|
|
|
elsif FileS = Nul then
|
elsif FileS = Nul then
|
FileB := Given_File;
|
FileB := Given_File;
|
|
|
else
|
else
|
raise Err;
|
raise Err;
|
end if;
|
end if;
|
end if;
|
end if;
|
|
|
Open (InS, In_File, "sinfo.ads");
|
Open (InS, In_File, "sinfo.ads");
|
Open (InT, In_File, "nmake.adt");
|
Open (InT, In_File, "nmake.adt");
|
|
|
if FileS /= Nul then
|
if FileS /= Nul then
|
Create (OutS, Out_File, S (FileS));
|
Create (OutS, Out_File, S (FileS));
|
end if;
|
end if;
|
|
|
if FileB /= Nul then
|
if FileB /= Nul then
|
Create (OutB, Out_File, S (FileB));
|
Create (OutB, Out_File, S (FileB));
|
end if;
|
end if;
|
|
|
Anchored_Mode := True;
|
Anchored_Mode := True;
|
|
|
-- Copy initial part of template to spec and body
|
-- Copy initial part of template to spec and body
|
|
|
loop
|
loop
|
Line := Get_Line (InT);
|
Line := Get_Line (InT);
|
|
|
-- Skip lines describing the template
|
-- Skip lines describing the template
|
|
|
if Match (Line, "-- This file is a template") then
|
if Match (Line, "-- This file is a template") then
|
loop
|
loop
|
Line := Get_Line (InT);
|
Line := Get_Line (InT);
|
exit when Line = "";
|
exit when Line = "";
|
end loop;
|
end loop;
|
end if;
|
end if;
|
|
|
-- Loop keeps going until "package" keyword written
|
-- Loop keeps going until "package" keyword written
|
|
|
exit when Match (Line, "package");
|
exit when Match (Line, "package");
|
|
|
-- Deal with WITH lines, writing to body or spec as appropriate
|
-- Deal with WITH lines, writing to body or spec as appropriate
|
|
|
if Match (Line, Body_Only, M) then
|
if Match (Line, Body_Only, M) then
|
Replace (M, X);
|
Replace (M, X);
|
WriteB (Line);
|
WriteB (Line);
|
|
|
elsif Match (Line, Spec_Only, M) then
|
elsif Match (Line, Spec_Only, M) then
|
Replace (M, X);
|
Replace (M, X);
|
WriteS (Line);
|
WriteS (Line);
|
|
|
-- Change header from Template to Spec and write to spec file
|
-- Change header from Template to Spec and write to spec file
|
|
|
else
|
else
|
if Match (Line, Templ, M) then
|
if Match (Line, Templ, M) then
|
Replace (M, A & " S p e c ");
|
Replace (M, A & " S p e c ");
|
end if;
|
end if;
|
|
|
WriteS (Line);
|
WriteS (Line);
|
|
|
-- Write header line to body file
|
-- Write header line to body file
|
|
|
if Match (Line, Spec, M) then
|
if Match (Line, Spec, M) then
|
Replace (M, A & "B o d y");
|
Replace (M, A & "B o d y");
|
end if;
|
end if;
|
|
|
WriteB (Line);
|
WriteB (Line);
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
-- Package line reached
|
-- Package line reached
|
|
|
WriteS ("package Nmake is");
|
WriteS ("package Nmake is");
|
WriteB ("package body Nmake is");
|
WriteB ("package body Nmake is");
|
WriteB ("");
|
WriteB ("");
|
|
|
-- Copy rest of lines up to template insert point to spec only
|
-- Copy rest of lines up to template insert point to spec only
|
|
|
loop
|
loop
|
Line := Get_Line (InT);
|
Line := Get_Line (InT);
|
exit when Match (Line, "!!TEMPLATE INSERTION POINT");
|
exit when Match (Line, "!!TEMPLATE INSERTION POINT");
|
WriteS (Line);
|
WriteS (Line);
|
end loop;
|
end loop;
|
|
|
-- Here we are doing the actual insertions, loop through node types
|
-- Here we are doing the actual insertions, loop through node types
|
|
|
loop
|
loop
|
Line := Get_Line (InS);
|
Line := Get_Line (InS);
|
|
|
if Match (Line, Node_Hdr)
|
if Match (Line, Node_Hdr)
|
and then not Match (Node, Punc)
|
and then not Match (Node, Punc)
|
and then Node /= "Unused"
|
and then Node /= "Unused"
|
then
|
then
|
exit when Node = "Empty";
|
exit when Node = "Empty";
|
Prevl := " function Make_" & Node & " (Sloc : Source_Ptr";
|
Prevl := " function Make_" & Node & " (Sloc : Source_Ptr";
|
Arg_List := Nul;
|
Arg_List := Nul;
|
|
|
-- Loop through fields of one node
|
-- Loop through fields of one node
|
|
|
loop
|
loop
|
Line := Get_Line (InS);
|
Line := Get_Line (InS);
|
exit when Line = "";
|
exit when Line = "";
|
|
|
if Match (Line, Binop) then
|
if Match (Line, Binop) then
|
WriteBS (Prevl & ';');
|
WriteBS (Prevl & ';');
|
Append (Arg_List, "Left_Opnd,Right_Opnd,");
|
Append (Arg_List, "Left_Opnd,Right_Opnd,");
|
WriteBS (
|
WriteBS (
|
" " & Rpad ("Left_Opnd", NWidth) & " : Node_Id;");
|
" " & Rpad ("Left_Opnd", NWidth) & " : Node_Id;");
|
Prevl :=
|
Prevl :=
|
" " & Rpad ("Right_Opnd", NWidth) & " : Node_Id";
|
" " & Rpad ("Right_Opnd", NWidth) & " : Node_Id";
|
|
|
elsif Match (Line, Unop) then
|
elsif Match (Line, Unop) then
|
WriteBS (Prevl & ';');
|
WriteBS (Prevl & ';');
|
Append (Arg_List, "Right_Opnd,");
|
Append (Arg_List, "Right_Opnd,");
|
Prevl := " " & Rpad ("Right_Opnd", NWidth) & " : Node_Id";
|
Prevl := " " & Rpad ("Right_Opnd", NWidth) & " : Node_Id";
|
|
|
elsif Match (Line, Syn) then
|
elsif Match (Line, Syn) then
|
if Synonym /= "Prev_Ids"
|
if Synonym /= "Prev_Ids"
|
and then Synonym /= "More_Ids"
|
and then Synonym /= "More_Ids"
|
and then Synonym /= "Comes_From_Source"
|
and then Synonym /= "Comes_From_Source"
|
and then Synonym /= "Paren_Count"
|
and then Synonym /= "Paren_Count"
|
and then not Match (Field, Sem_Field)
|
and then not Match (Field, Sem_Field)
|
and then not Match (Field, Lib_Field)
|
and then not Match (Field, Lib_Field)
|
then
|
then
|
Match (Field, Get_Field);
|
Match (Field, Get_Field);
|
|
|
if Field = "Str" then
|
if Field = "Str" then
|
Field := V_String_Id;
|
Field := V_String_Id;
|
elsif Field = "Node" then
|
elsif Field = "Node" then
|
Field := V_Node_Id;
|
Field := V_Node_Id;
|
elsif Field = "Name" then
|
elsif Field = "Name" then
|
Field := V_Name_Id;
|
Field := V_Name_Id;
|
elsif Field = "List" then
|
elsif Field = "List" then
|
Field := V_List_Id;
|
Field := V_List_Id;
|
elsif Field = "Elist" then
|
elsif Field = "Elist" then
|
Field := V_Elist_Id;
|
Field := V_Elist_Id;
|
elsif Field = "Flag" then
|
elsif Field = "Flag" then
|
Field := V_Boolean;
|
Field := V_Boolean;
|
end if;
|
end if;
|
|
|
if Field = "Boolean" then
|
if Field = "Boolean" then
|
Default := V ("False");
|
Default := V ("False");
|
else
|
else
|
Default := Nul;
|
Default := Nul;
|
end if;
|
end if;
|
|
|
Match (Comment, Get_Dflt);
|
Match (Comment, Get_Dflt);
|
|
|
WriteBS (Prevl & ';');
|
WriteBS (Prevl & ';');
|
Append (Arg_List, Synonym & ',');
|
Append (Arg_List, Synonym & ',');
|
Rpad (Synonym, NWidth);
|
Rpad (Synonym, NWidth);
|
|
|
if Default = "" then
|
if Default = "" then
|
Prevl := " " & Synonym & " : " & Field;
|
Prevl := " " & Synonym & " : " & Field;
|
else
|
else
|
Prevl :=
|
Prevl :=
|
" " & Synonym & " : " & Field & " := " & Default;
|
" " & Synonym & " : " & Field & " := " & Default;
|
end if;
|
end if;
|
end if;
|
end if;
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
WriteBS (Prevl & ')');
|
WriteBS (Prevl & ')');
|
WriteS (" return Node_Id;");
|
WriteS (" return Node_Id;");
|
WriteS (" pragma Inline (Make_" & Node & ");");
|
WriteS (" pragma Inline (Make_" & Node & ");");
|
WriteB (" return Node_Id");
|
WriteB (" return Node_Id");
|
WriteB (" is");
|
WriteB (" is");
|
WriteB (" N : constant Node_Id :=");
|
WriteB (" N : constant Node_Id :=");
|
|
|
if Match (Node, "Defining_Identifier") or else
|
if Match (Node, "Defining_Identifier") or else
|
Match (Node, "Defining_Character") or else
|
Match (Node, "Defining_Character") or else
|
Match (Node, "Defining_Operator")
|
Match (Node, "Defining_Operator")
|
then
|
then
|
WriteB (" New_Entity (N_" & Node & ", Sloc);");
|
WriteB (" New_Entity (N_" & Node & ", Sloc);");
|
else
|
else
|
WriteB (" New_Node (N_" & Node & ", Sloc);");
|
WriteB (" New_Node (N_" & Node & ", Sloc);");
|
end if;
|
end if;
|
|
|
WriteB (" begin");
|
WriteB (" begin");
|
|
|
while Match (Arg_List, Next_Arg, "") loop
|
while Match (Arg_List, Next_Arg, "") loop
|
if Length (Arg) < NWidth then
|
if Length (Arg) < NWidth then
|
WriteB (" Set_" & Arg & " (N, " & Arg & ");");
|
WriteB (" Set_" & Arg & " (N, " & Arg & ");");
|
else
|
else
|
WriteB (" Set_" & Arg);
|
WriteB (" Set_" & Arg);
|
WriteB (" (N, " & Arg & ");");
|
WriteB (" (N, " & Arg & ");");
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
if Match (Node, Op_Node) then
|
if Match (Node, Op_Node) then
|
if Node = "Op_Plus" then
|
if Node = "Op_Plus" then
|
WriteB (" Set_Chars (N, Name_Op_Add);");
|
WriteB (" Set_Chars (N, Name_Op_Add);");
|
|
|
elsif Node = "Op_Minus" then
|
elsif Node = "Op_Minus" then
|
WriteB (" Set_Chars (N, Name_Op_Subtract);");
|
WriteB (" Set_Chars (N, Name_Op_Subtract);");
|
|
|
elsif Match (Op_Name, Shft_Rot) then
|
elsif Match (Op_Name, Shft_Rot) then
|
WriteB (" Set_Chars (N, Name_" & Op_Name & ");");
|
WriteB (" Set_Chars (N, Name_" & Op_Name & ");");
|
|
|
else
|
else
|
WriteB (" Set_Chars (N, Name_" & Node & ");");
|
WriteB (" Set_Chars (N, Name_" & Node & ");");
|
end if;
|
end if;
|
|
|
if not Match (Op_Name, No_Ent) then
|
if not Match (Op_Name, No_Ent) then
|
WriteB (" Set_Entity (N, Standard_" & Node & ");");
|
WriteB (" Set_Entity (N, Standard_" & Node & ");");
|
end if;
|
end if;
|
end if;
|
end if;
|
|
|
WriteB (" return N;");
|
WriteB (" return N;");
|
WriteB (" end Make_" & Node & ';');
|
WriteB (" end Make_" & Node & ';');
|
WriteBS ("");
|
WriteBS ("");
|
end if;
|
end if;
|
end loop;
|
end loop;
|
|
|
WriteBS ("end Nmake;");
|
WriteBS ("end Nmake;");
|
|
|
exception
|
exception
|
|
|
when Err =>
|
when Err =>
|
Put_Line (Standard_Error, "usage: xnmake [-b] [-s] [filename]");
|
Put_Line (Standard_Error, "usage: xnmake [-b] [-s] [filename]");
|
Set_Exit_Status (1);
|
Set_Exit_Status (1);
|
|
|
end XNmake;
|
end XNmake;
|
|
|