------------------------------------------------------------------------------ -- -- -- GNAT SYSTEM UTILITIES -- -- -- -- X N M A K E -- -- -- -- B o d y -- -- -- -- $Revision: 1.29 $ -- -- -- Copyright (C) 1992-2001 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, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ -- 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.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; Sinfo_Rev : VString := Nul; Synonym : VString := Nul; Temp_Rev : VString := Nul; X : VString := Nul; XNmake_Rev : VString := Nul; Lineno : Natural; 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 InS, InT : File_Type; OutS, OutB : File_Type; wsp : Pattern := Span (' ' & ASCII.HT); -- Note: in following patterns, we break up the word revision to -- avoid RCS getting enthusiastic about updating the reference! Get_SRev : Pattern := BreakX ('$') & "$Rev" & "ision: " & Break (' ') * Sinfo_Rev; GetT_Rev : Pattern := BreakX ('$') & "$Rev" & "ision: " & Break (' ') * Temp_Rev; 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 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; -- Start of processing for XNmake begin -- Capture our revision (following line updated by RCS) Match ("$Revision: 1.29 $", "$Rev" & "ision: " & Break (' ') * XNmake_Rev); Lineno := 0; 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; -- Get Sinfo revision number loop Line := Get_Line (InS); exit when Match (Line, Get_SRev); end loop; -- Copy initial part of template to spec and body loop Line := Get_Line (InT); if Match (Line, GetT_Rev) then WriteBS ("-- Generated by xnmake revision " & XNmake_Rev & " using" & " --"); WriteBS ("-- sinfo.ads revision " & Sinfo_Rev & " --"); WriteBS ("-- nmake.adt revision " & Temp_Rev & " --"); else -- 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; exit when Match (Line, "package"); if Match (Line, Body_Only, M) then Replace (M, X); WriteB (Line); elsif Match (Line, Spec_Only, M) then Replace (M, X); WriteS (Line); else if Match (Line, Templ, M) then Replace (M, A & " S p e c "); end if; WriteS (Line); if Match (Line, Spec, M) then Replace (M, A & "B o d y"); end if; WriteB (Line); end if; 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;