X-Git-Url: https://oss.titaniummirror.com/gitweb?a=blobdiff_plain;f=gcc%2Fada%2Fxtreeprs.adb;fp=gcc%2Fada%2Fxtreeprs.adb;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=12b489f10da5561b48354af86f04fac3ead8b11e;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/ada/xtreeprs.adb b/gcc/ada/xtreeprs.adb deleted file mode 100644 index 12b489f1..00000000 --- a/gcc/ada/xtreeprs.adb +++ /dev/null @@ -1,384 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT SYSTEM UTILITIES -- --- -- --- X T R E E P R S -- --- -- --- B o d y -- --- -- --- $Revision: 1.1.16.2 $ --- -- --- 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. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- Program to construct the spec of the Treeprs package - --- Input files: - --- sinfo.ads Spec of Sinfo package --- treeprs.adt Template for Treeprs package - --- Output files: - --- treeprs.ads Spec of Treeprs package - --- Note: this program assumes that sinfo.ads has passed the error checks which --- are carried out by the CSinfo utility so it does not duplicate these checks - --- An optional argument allows the specification of an output file name to --- override the default treeprs.ads file name for the generated output file. - -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.Text_IO; use Ada.Text_IO; - -with GNAT.Spitbol; use GNAT.Spitbol; -with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; -with GNAT.Spitbol.Table_Boolean; use GNAT.Spitbol.Table_Boolean; -with GNAT.Spitbol.Table_VString; use GNAT.Spitbol.Table_VString; - -procedure XTreeprs is - - package TB renames GNAT.Spitbol.Table_Boolean; - package TV renames GNAT.Spitbol.Table_VString; - - Err : exception; - -- Raised on fatal error - - A : VString := Nul; - Ffield : VString := Nul; - Field : VString := Nul; - Fieldno : VString := Nul; - Flagno : VString := Nul; - Line : VString := Nul; - Name : VString := Nul; - Node : VString := Nul; - Outstring : VString := Nul; - Prefix : VString := Nul; - S : VString := Nul; - S1 : VString := Nul; - Sinforev : VString := Nul; - Syn : VString := Nul; - Synonym : VString := Nul; - Temprev : VString := Nul; - Term : VString := Nul; - Treeprsrev : VString := Nul; - - OutS : File_Type; - -- Output file - - InS : File_Type; - -- Read sinfo.ads - - InT : File_Type; - -- Read treeprs.adt - - Special : TB.Table (20); - -- Table of special fields. These fields are not included in the table - -- constructed by Xtreeprs, since they are specially handled in treeprs. - -- This means these field definitions are completely ignored. - - Names : array (1 .. 500) of VString; - -- Table of names of synonyms - - Positions : array (1 .. 500) of Natural; - -- Table of starting positions in Pchars string for synonyms - - Strings : TV.Table (300); - -- Contribution of each synonym to Pchars string, indexed by name - - Count : Natural := 0; - -- Number of synonyms processed so far - - Curpos : Natural := 1; - -- Number of characters generated in Pchars string so far - - Lineno : Natural := 0; - -- Line number in sinfo.ads - - Field_Base : constant := Character'Pos ('#'); - -- Fields 1-5 are represented by the characters #$%&' (i.e. by five - -- contiguous characters starting at # (16#23#)). - - Flag_Base : constant := Character'Pos ('('); - -- Flags 1-18 are represented by the characters ()*+,-./0123456789 - -- (i.e. by 18 contiguous characters starting at (16#28#)). - - Fieldch : Character; - -- Field character, as per above tables - - Sp : aliased Natural; - -- Space left on line for Pchars output - - wsp : Pattern := Span (' ' & ASCII.HT); - - Get_SRev : Pattern := BreakX ('$') & "$Rev" & "ision: " - & Break (' ') * Sinforev; - Get_TRev : Pattern := BreakX ('$') & "$Rev" & "ision: " - & Break (' ') * Temprev; - Is_Temp : Pattern := BreakX ('T') * A & "T e m p l a t e"; - Get_Node : Pattern := wsp & "-- N_" & Rest * Node; - Tst_Punc : Pattern := Break (" ,."); - Get_Syn : Pattern := Span (' ') & "-- " & Break (' ') * Synonym - & " (" & Break (')') * Field; - Brk_Min : Pattern := Break ('-') * Ffield; - Is_Flag : Pattern := "Flag" & Rest * Flagno; - Is_Field : Pattern := Rtab (1) & Len (1) * Fieldno; - Is_Syn : Pattern := wsp & "N_" & Break (",)") * Syn & Len (1) * Term; - Brk_Node : Pattern := Break (' ') * Node & ' '; - Chop_SP : Pattern := Len (Sp'Unrestricted_Access) * S1; - - M : Match_Result; - -begin - Anchored_Mode := True; - - Match ("$Revision: 1.1.16.2 $", - "$Rev" & "ision: " & Break (' ') * Treeprsrev); - - if Argument_Count > 0 then - Create (OutS, Out_File, Argument (1)); - else - Create (OutS, Out_File, "treeprs.ads"); - end if; - - Open (InS, In_File, "sinfo.ads"); - Open (InT, In_File, "treeprs.adt"); - - -- Initialize special fields table - - Set (Special, "Analyzed", True); - Set (Special, "Cannot_Be_Constant", True); - Set (Special, "Chars", True); - Set (Special, "Comes_From_Source", True); - Set (Special, "Error_Posted", True); - Set (Special, "Etype", True); - Set (Special, "Has_No_Side_Effects", True); - Set (Special, "Is_Controlling_Actual", True); - Set (Special, "Is_Overloaded", True); - Set (Special, "Is_Static_Expression", True); - Set (Special, "Left_Opnd", True); - Set (Special, "Must_Check_Expr", True); - Set (Special, "No_Overflow_Expr", True); - Set (Special, "Paren_Count", True); - Set (Special, "Raises_Constraint_Error", True); - Set (Special, "Right_Opnd", True); - - -- Get sinfo revs and write header to output file - - loop - Line := Get_Line (InS); - Lineno := Lineno + 1; - - if Line = "" then - raise Err; - end if; - - exit when Match (Line, Get_SRev); - end loop; - - -- Read template header and generate new header - - loop - Line := Get_Line (InT); - - if Match (Line, Get_TRev) then - Put_Line - (OutS, - "-- Generated by xtreeprs revision " & - Treeprsrev & " using"); - - Put_Line - (OutS, - "-- sinfo.ads revision " & - Sinforev); - - Put_Line - (OutS, - "-- treeprs.adt revision " - & Temprev); - - 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, Is_Temp, M) then - Replace (M, A & " S p e c "); - end if; - - Put_Line (OutS, Line); - end if; - end loop; - - Put_Line (OutS, Line); - - -- Copy rest of comments up to template insert point to spec - - loop - Line := Get_Line (InT); - exit when Match (Line, "!!TEMPLATE INSERTION POINT"); - Put_Line (OutS, Line); - end loop; - - -- Here we are doing the actual insertions - - Put_Line (OutS, " Pchars : constant String :="); - - -- Loop through comments describing nodes, picking up fields - - loop - Line := Get_Line (InS); - Lineno := Lineno + 1; - exit when Match (Line, " type Node_Kind"); - - if Match (Line, Get_Node) - and then not Match (Node, Tst_Punc) - then - Outstring := Node & ' '; - - loop - Line := Get_Line (InS); - exit when Line = ""; - - if Match (Line, Get_Syn) - and then not Match (Synonym, "plus") - and then not Present (Special, Synonym) - then - -- Convert this field into the character used to - -- represent the field according to the table: - - -- Field1 '#' - -- Field2 '$' - -- Field3 '%' - -- Field4 '&' - -- Field5 "'" - -- Flag1 "(" - -- Flag2 ")" - -- Flag3 '*' - -- Flag4 '+' - -- Flag5 ',' - -- Flag6 '-' - -- Flag7 '.' - -- Flag8 '/' - -- Flag9 '0' - -- Flag10 '1' - -- Flag11 '2' - -- Flag12 '3' - -- Flag13 '4' - -- Flag14 '5' - -- Flag15 '6' - -- Flag16 '7' - -- Flag17 '8' - -- Flag18 '9' - - if Match (Field, Brk_Min) then - Field := Ffield; - end if; - - if Match (Field, Is_Flag) then - Fieldch := Char (Flag_Base - 1 + N (Flagno)); - - elsif Match (Field, Is_Field) then - Fieldch := Char (Field_Base - 1 + N (Fieldno)); - - else - Put_Line - (Standard_Error, - "*** Line " & - Lineno & - " has unrecognized field name " & - Field); - raise Err; - end if; - - Append (Outstring, Fieldch & Synonym); - end if; - end loop; - - Set (Strings, Node, Outstring); - end if; - end loop; - - -- Loop through actual definitions of node kind enumeration literals - - loop - loop - Line := Get_Line (InS); - Lineno := Lineno + 1; - exit when Match (Line, Is_Syn); - end loop; - - S := Get (Strings, Syn); - Match (S, Brk_Node, ""); - Count := Count + 1; - Names (Count) := Syn; - Positions (Count) := Curpos; - Curpos := Curpos + Length (S); - Put_Line (OutS, " -- " & Node); - Prefix := V (" "); - exit when Term = ")"; - - -- Loop to output the string literal for Pchars - - loop - Sp := 79 - 4 - Length (Prefix); - exit when (Size (S) <= Sp); - Match (S, Chop_SP, ""); - Put_Line (OutS, Prefix & '"' & S1 & """ &"); - Prefix := V (" "); - end loop; - - Put_Line (OutS, Prefix & '"' & S & """ &"); - end loop; - - Put_Line (OutS, " """";"); - Put_Line (OutS, ""); - Put_Line - (OutS, " type Pchar_Pos_Array is array (Node_Kind) of Positive;"); - Put_Line - (OutS, - " Pchar_Pos : constant Pchar_Pos_Array := Pchar_Pos_Array'("); - - -- Output lines for Pchar_Pos_Array values - - for M in 1 .. Count - 1 loop - Name := Rpad ("N_" & Names (M), 40); - Put_Line (OutS, " " & Name & " => " & Positions (M) & ','); - end loop; - - Name := Rpad ("N_" & Names (Count), 40); - Put_Line (OutS, " " & Name & " => " & Positions (Count) & ");"); - - Put_Line (OutS, ""); - Put_Line (OutS, "end Treeprs;"); - -exception - when Err => - Put_Line (Standard_Error, "*** fatal error"); - Set_Exit_Status (1); - -end XTreeprs;