diff options
Diffstat (limited to 'gcc-4.2.1/gcc/ada/xnmake.adb')
| -rw-r--r-- | gcc-4.2.1/gcc/ada/xnmake.adb | 465 |
1 files changed, 465 insertions, 0 deletions
diff --git a/gcc-4.2.1/gcc/ada/xnmake.adb b/gcc-4.2.1/gcc/ada/xnmake.adb new file mode 100644 index 000000000..ec08692e2 --- /dev/null +++ b/gcc-4.2.1/gcc/ada/xnmake.adb @@ -0,0 +1,465 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT SYSTEM UTILITIES -- +-- -- +-- X N M A K E -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- -- +-- 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- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- 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 -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- Program to construct the spec and body of the Nmake package + +-- Input files: + +-- sinfo.ads Spec of Sinfo package +-- nmake.adt Template for Nmake package + +-- Output files: + +-- nmake.ads Spec of Nmake package +-- nmake.adb Body of Nmake package + +-- 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 +-- checks and assumes that sinfo.ads has the correct form. + +-- 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 -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 +-- 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. + +with Ada.Command_Line; use Ada.Command_Line; +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; +with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; +with Ada.Strings.Maps; use Ada.Strings.Maps; +with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; +with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; +with Ada.Text_IO; use Ada.Text_IO; + +with GNAT.Spitbol; use GNAT.Spitbol; +with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; + +procedure XNmake is + + Err : exception; + -- Raised to terminate execution + + A : VString := Nul; + Arg : VString := Nul; + Arg_List : VString := Nul; + Comment : VString := Nul; + Default : VString := Nul; + Field : VString := Nul; + Line : VString := Nul; + Node : VString := Nul; + Op_Name : VString := Nul; + Prevl : VString := Nul; + Synonym : VString := Nul; + X : VString := Nul; + + NWidth : Natural; + + FileS : VString := V ("nmake.ads"); + FileB : VString := V ("nmake.adb"); + -- Set to null if corresponding file not to be generated + + Given_File : VString := Nul; + -- File name given by command line argument + + subtype Sfile is Ada.Streams.Stream_IO.File_Type; + + InS, InT : Ada.Text_IO.File_Type; + OutS, OutB : Sfile; + + wsp : Pattern := Span (' ' & ASCII.HT); + + Body_Only : Pattern := BreakX (' ') * X & Span (' ') & "-- body only"; + Spec_Only : Pattern := BreakX (' ') * X & Span (' ') & "-- spec only"; + + Node_Hdr : Pattern := wsp & "-- N_" & Rest * Node; + Punc : Pattern := BreakX (" .,"); + + Binop : Pattern := wsp & "-- plus fields for binary operator"; + Unop : Pattern := wsp & "-- plus fields for unary operator"; + Syn : Pattern := wsp & "-- " & Break (' ') * Synonym + & " (" & Break (')') * Field & Rest * Comment; + + Templ : Pattern := BreakX ('T') * A & "T e m p l a t e"; + Spec : Pattern := BreakX ('S') * A & "S p e c"; + + Sem_Field : Pattern := BreakX ('-') & "-Sem"; + Lib_Field : Pattern := BreakX ('-') & "-Lib"; + + Get_Field : Pattern := BreakX (Decimal_Digit_Set) * Field; + + Get_Dflt : Pattern := BreakX ('(') & "(set to " + & Break (" ") * Default & " if"; + + Next_Arg : Pattern := Break (',') * Arg & ','; + + Op_Node : Pattern := "Op_" & Rest * Op_Name; + + Shft_Rot : Pattern := "Shift_" or "Rotate_"; + + No_Ent : Pattern := "Or_Else" or "And_Then" or "In" or "Not_In"; + + M : Match_Result; + + V_String_Id : constant VString := V ("String_Id"); + V_Node_Id : constant VString := V ("Node_Id"); + V_Name_Id : constant VString := V ("Name_Id"); + V_List_Id : constant VString := V ("List_Id"); + V_Elist_Id : constant VString := V ("Elist_Id"); + V_Boolean : constant VString := V ("Boolean"); + + procedure Put_Line (F : Sfile; S : String); + procedure Put_Line (F : Sfile; S : VString); + -- Local version of Put_Line ensures Unix style line endings + + procedure WriteS (S : String); + procedure WriteB (S : String); + procedure WriteBS (S : String); + procedure WriteS (S : VString); + procedure WriteB (S : VString); + procedure WriteBS (S : VString); + -- Write given line to spec or body file or both if active + + procedure WriteB (S : String) is + begin + if FileB /= Nul then + Put_Line (OutB, S); + end if; + end WriteB; + + procedure WriteB (S : VString) is + begin + if FileB /= Nul then + Put_Line (OutB, S); + end if; + end WriteB; + + procedure WriteBS (S : String) is + begin + if FileB /= Nul then + Put_Line (OutB, S); + end if; + + if FileS /= Nul then + Put_Line (OutS, S); + end if; + end WriteBS; + + procedure WriteBS (S : VString) is + begin + if FileB /= Nul then + Put_Line (OutB, S); + end if; + + if FileS /= Nul then + Put_Line (OutS, S); + end if; + end WriteBS; + + procedure WriteS (S : String) is + begin + if FileS /= Nul then + Put_Line (OutS, S); + end if; + end WriteS; + + procedure WriteS (S : VString) is + begin + if FileS /= Nul then + Put_Line (OutS, S); + end if; + end WriteS; + + procedure Put_Line (F : Sfile; S : String) is + begin + String'Write (Stream (F), S); + Character'Write (Stream (F), ASCII.LF); + end Put_Line; + + procedure Put_Line (F : Sfile; S : VString) is + begin + Put_Line (F, To_String (S)); + end Put_Line; + +-- Start of processing for XNmake + +begin + NWidth := 28; + Anchored_Mode := True; + + for ArgN in 1 .. Argument_Count loop + declare + Arg : constant String := Argument (ArgN); + + begin + if Arg (1) = '-' then + if Arg'Length = 2 + and then (Arg (2) = 'b' or else Arg (2) = 'B') + then + FileS := Nul; + + elsif Arg'Length = 2 + and then (Arg (2) = 's' or else Arg (2) = 'S') + then + FileB := Nul; + + else + raise Err; + end if; + + else + if Given_File /= Nul then + raise Err; + else + Given_File := V (Arg); + end if; + end if; + end; + end loop; + + if FileS = Nul and then FileB = Nul then + raise Err; + + elsif Given_File /= Nul then + if FileB = Nul then + FileS := Given_File; + + elsif FileS = Nul then + FileB := Given_File; + + else + raise Err; + end if; + end if; + + Open (InS, In_File, "sinfo.ads"); + Open (InT, In_File, "nmake.adt"); + + if FileS /= Nul then + Create (OutS, Out_File, S (FileS)); + end if; + + if FileB /= Nul then + Create (OutB, Out_File, S (FileB)); + end if; + + Anchored_Mode := True; + + -- Copy initial part of template to spec and body + + loop + Line := Get_Line (InT); + + -- Skip lines describing the template + + if Match (Line, "-- This file is a template") then + loop + Line := Get_Line (InT); + exit when Line = ""; + end loop; + end if; + + -- Loop keeps going until "package" keyword written + + exit when Match (Line, "package"); + + -- Deal with WITH lines, writing to body or spec as appropriate + + if Match (Line, Body_Only, M) then + Replace (M, X); + WriteB (Line); + + elsif Match (Line, Spec_Only, M) then + Replace (M, X); + WriteS (Line); + + -- Change header from Template to Spec and write to spec file + + else + if Match (Line, Templ, M) then + Replace (M, A & " S p e c "); + end if; + + WriteS (Line); + + -- Write header line to body file + + if Match (Line, Spec, M) then + Replace (M, A & "B o d y"); + end if; + + WriteB (Line); + end if; + end loop; + + -- Package line reached + + WriteS ("package Nmake is"); + WriteB ("package body Nmake is"); + WriteB (""); + + -- Copy rest of lines up to template insert point to spec only + + loop + Line := Get_Line (InT); + exit when Match (Line, "!!TEMPLATE INSERTION POINT"); + WriteS (Line); + end loop; + + -- Here we are doing the actual insertions, loop through node types + + loop + Line := Get_Line (InS); + + if Match (Line, Node_Hdr) + and then not Match (Node, Punc) + and then Node /= "Unused" + then + exit when Node = "Empty"; + Prevl := " function Make_" & Node & " (Sloc : Source_Ptr"; + Arg_List := Nul; + + -- Loop through fields of one node + + loop + Line := Get_Line (InS); + exit when Line = ""; + + if Match (Line, Binop) then + WriteBS (Prevl & ';'); + Append (Arg_List, "Left_Opnd,Right_Opnd,"); + WriteBS ( + " " & Rpad ("Left_Opnd", NWidth) & " : Node_Id;"); + Prevl := + " " & Rpad ("Right_Opnd", NWidth) & " : Node_Id"; + + elsif Match (Line, Unop) then + WriteBS (Prevl & ';'); + Append (Arg_List, "Right_Opnd,"); + Prevl := " " & Rpad ("Right_Opnd", NWidth) & " : Node_Id"; + + elsif Match (Line, Syn) then + if Synonym /= "Prev_Ids" + and then Synonym /= "More_Ids" + and then Synonym /= "Comes_From_Source" + and then Synonym /= "Paren_Count" + and then not Match (Field, Sem_Field) + and then not Match (Field, Lib_Field) + then + Match (Field, Get_Field); + + if Field = "Str" then Field := V_String_Id; + elsif Field = "Node" then Field := V_Node_Id; + elsif Field = "Name" then Field := V_Name_Id; + elsif Field = "List" then Field := V_List_Id; + elsif Field = "Elist" then Field := V_Elist_Id; + elsif Field = "Flag" then Field := V_Boolean; + end if; + + if Field = "Boolean" then + Default := V ("False"); + else + Default := Nul; + end if; + + Match (Comment, Get_Dflt); + + WriteBS (Prevl & ';'); + Append (Arg_List, Synonym & ','); + Rpad (Synonym, NWidth); + + if Default = "" then + Prevl := " " & Synonym & " : " & Field; + else + Prevl := + " " & Synonym & " : " & Field & " := " & Default; + end if; + end if; + end if; + end loop; + + WriteBS (Prevl & ')'); + WriteS (" return Node_Id;"); + WriteS (" pragma Inline (Make_" & Node & ");"); + WriteB (" return Node_Id"); + WriteB (" is"); + WriteB (" N : constant Node_Id :="); + + if Match (Node, "Defining_Identifier") or else + Match (Node, "Defining_Character") or else + Match (Node, "Defining_Operator") + then + WriteB (" New_Entity (N_" & Node & ", Sloc);"); + else + WriteB (" New_Node (N_" & Node & ", Sloc);"); + end if; + + WriteB (" begin"); + + while Match (Arg_List, Next_Arg, "") loop + if Length (Arg) < NWidth then + WriteB (" Set_" & Arg & " (N, " & Arg & ");"); + else + WriteB (" Set_" & Arg); + WriteB (" (N, " & Arg & ");"); + end if; + end loop; + + if Match (Node, Op_Node) then + if Node = "Op_Plus" then + WriteB (" Set_Chars (N, Name_Op_Add);"); + + elsif Node = "Op_Minus" then + WriteB (" Set_Chars (N, Name_Op_Subtract);"); + + elsif Match (Op_Name, Shft_Rot) then + WriteB (" Set_Chars (N, Name_" & Op_Name & ");"); + + else + WriteB (" Set_Chars (N, Name_" & Node & ");"); + end if; + + if not Match (Op_Name, No_Ent) then + WriteB (" Set_Entity (N, Standard_" & Node & ");"); + end if; + end if; + + WriteB (" return N;"); + WriteB (" end Make_" & Node & ';'); + WriteBS (""); + end if; + end loop; + + WriteBS ("end Nmake;"); + +exception + + when Err => + Put_Line (Standard_Error, "usage: xnmake [-b] [-s] [filename]"); + Set_Exit_Status (1); + +end XNmake; |