diff options
Diffstat (limited to 'gcc-4.2.1/gcc/ada/xsinfo.adb')
| -rw-r--r-- | gcc-4.2.1/gcc/ada/xsinfo.adb | 247 |
1 files changed, 0 insertions, 247 deletions
diff --git a/gcc-4.2.1/gcc/ada/xsinfo.adb b/gcc-4.2.1/gcc/ada/xsinfo.adb deleted file mode 100644 index 035109b7c..000000000 --- a/gcc-4.2.1/gcc/ada/xsinfo.adb +++ /dev/null @@ -1,247 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT SYSTEM UTILITIES -- --- -- --- X S I N F O -- --- -- --- 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 C header file sinfo.h (C version of sinfo.ads spec, --- for use by Gigi, contains all definitions and access functions, but does --- not contain set procedures, since Gigi never modifies the GNAT tree) - --- Input files: - --- sinfo.ads Spec of Sinfo package - --- Output files: - --- sinfo.h Corresponding c header file - --- 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 and assumes the soruce is correct. - --- An optional argument allows the specification of an output file name to --- override the default sinfo.h 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; - -procedure XSinfo is - - Done : exception; - Err : exception; - - A : VString := Nul; - Arg : VString := Nul; - Comment : VString := Nul; - Line : VString := Nul; - N : VString := Nul; - N1, N2 : VString := Nul; - Nam : VString := Nul; - Rtn : VString := Nul; - Term : VString := Nul; - - InS : File_Type; - Ofile : File_Type; - - wsp : Pattern := Span (' ' & ASCII.HT); - Wsp_For : Pattern := wsp & "for"; - Is_Cmnt : Pattern := wsp & "--"; - Typ_Nod : Pattern := wsp * A & "type Node_Kind is"; - Get_Nam : Pattern := wsp * A & "N_" & Break (",)") * Nam - & Len (1) * Term; - Sub_Typ : Pattern := wsp * A & "subtype " & Break (' ') * N; - No_Cont : Pattern := wsp & Break (' ') * N1 & " .. " & Break (';') * N2; - Cont_N1 : Pattern := wsp & Break (' ') * N1 & " .." & Rpos (0); - Cont_N2 : Pattern := Span (' ') & Break (';') * N2; - Is_Func : Pattern := wsp * A & "function " & Rest * Nam; - Get_Arg : Pattern := wsp & "(N : " & Break (')') * Arg - & ") return " & Break (';') * Rtn - & ';' & wsp & "--" & wsp & Rest * Comment; - - NKV : Natural; - - M : Match_Result; - - procedure Getline; - -- Get non-comment, non-blank line. Also skips "for " rep clauses - - ------------- - -- Getline -- - ------------- - - procedure Getline is - begin - loop - Line := Get_Line (InS); - - if Line /= "" - and then not Match (Line, Wsp_For) - and then not Match (Line, Is_Cmnt) - then - return; - - elsif Match (Line, " -- End functions (note") then - raise Done; - end if; - end loop; - end Getline; - --- Start of processing for XSinfo - -begin - Set_Exit_Status (1); - Anchored_Mode := True; - - if Argument_Count > 0 then - Create (Ofile, Out_File, Argument (1)); - else - Create (Ofile, Out_File, "sinfo.h"); - end if; - - Open (InS, In_File, "sinfo.ads"); - - -- Write header to output file - - loop - Line := Get_Line (InS); - exit when Line = ""; - - Match - (Line, - "-- S p e c ", - "-- C Header File "); - - Match (Line, "--", "/*"); - Match (Line, Rtab (2) * A & "--", M); - Replace (M, A & "*/"); - Put_Line (Ofile, Line); - end loop; - - -- Skip to package line - - loop - Getline; - exit when Match (Line, "package"); - end loop; - - -- Skip to first node kind line - - loop - Getline; - exit when Match (Line, Typ_Nod); - Put_Line (Ofile, Line); - end loop; - - Put_Line (Ofile, ""); - NKV := 0; - - -- Loop through node kind codes - - loop - Getline; - - if Match (Line, Get_Nam) then - Put_Line (Ofile, A & "#define N_" & Nam & ' ' & NKV); - NKV := NKV + 1; - exit when not Match (Term, ","); - - else - Put_Line (Ofile, Line); - end if; - end loop; - - Put_Line (Ofile, ""); - Put_Line (Ofile, A & "#define Number_Node_Kinds " & NKV); - - -- Loop through subtype declarations - - loop - Getline; - - if not Match (Line, Sub_Typ) then - exit when Match (Line, " function"); - Put_Line (Ofile, Line); - - else - Put_Line (Ofile, A & "SUBTYPE (" & N & ", Node_Kind, "); - Getline; - - -- Normal case - - if Match (Line, No_Cont) then - Put_Line (Ofile, A & " " & N1 & ", " & N2 & ')'); - - -- Continuation case - - else - if not Match (Line, Cont_N1) then - raise Err; - end if; - - Getline; - - if not Match (Line, Cont_N2) then - raise Err; - end if; - - Put_Line (Ofile, A & " " & N1 & ','); - Put_Line (Ofile, A & " " & N2 & ')'); - end if; - end if; - end loop; - - -- Loop through functions. Note that this loop is terminated by - -- the call to Getfile encountering the end of functions sentinel - - loop - if Match (Line, Is_Func) then - Getline; - if not Match (Line, Get_Arg) then - raise Err; - end if; - Put_Line - (Ofile, - A & "INLINE " & Rpad (Rtn, 9) - & ' ' & Rpad (Nam, 30) & " (" & Arg & " N)"); - - Put_Line (Ofile, A & " { return " & Comment & " (N); }"); - - else - Put_Line (Ofile, Line); - end if; - - Getline; - end loop; - -exception - when Done => - Put_Line (Ofile, ""); - Set_Exit_Status (0); - -end XSinfo; |