1 ------------------------------------------------------------------------------
3 -- GNAT SYSTEM UTILITIES --
9 -- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 -- Program to construct C header file sinfo.h (C version of sinfo.ads spec,
27 -- for use by Gigi, contains all definitions and access functions, but does
28 -- not contain set procedures, since Gigi never modifies the GNAT tree)
32 -- sinfo.ads Spec of Sinfo package
36 -- sinfo.h Corresponding c header file
38 -- Note: this program assumes that sinfo.ads has passed the error checks
39 -- which are carried out by the CSinfo utility, so it does not duplicate
40 -- these checks and assumes the soruce is correct.
42 -- An optional argument allows the specification of an output file name to
43 -- override the default sinfo.h file name for the generated output file.
45 with Ada.Command_Line; use Ada.Command_Line;
46 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
47 with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
48 with Ada.Text_IO; use Ada.Text_IO;
50 with GNAT.Spitbol; use GNAT.Spitbol;
51 with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns;
58 pragma Warnings (Off);
59 -- Below variables are referenced using * operator
63 Comment : VString := Nul;
64 Line : VString := Nul;
66 N1, N2 : VString := Nul;
69 Term : VString := Nul;
76 wsp : constant Pattern := Span (' ' & ASCII.HT);
77 Wsp_For : constant Pattern := wsp & "for";
78 Is_Cmnt : constant Pattern := wsp & "--";
79 Typ_Nod : constant Pattern := wsp * A & "type Node_Kind is";
80 Get_Nam : constant Pattern := wsp * A & "N_" & Break (",)") * Nam
82 Sub_Typ : constant Pattern := wsp * A & "subtype " & Break (' ') * N;
83 No_Cont : constant Pattern := wsp & Break (' ') * N1
84 & " .. " & Break (';') * N2;
85 Cont_N1 : constant Pattern := wsp & Break (' ') * N1 & " .." & Rpos (0);
86 Cont_N2 : constant Pattern := Span (' ') & Break (';') * N2;
87 Is_Func : constant Pattern := wsp * A & "function " & Rest * Nam;
88 Get_Arg : constant Pattern := wsp & "(N : " & Break (')') * Arg
89 & ") return " & Break (';') * Rtn
90 & ';' & wsp & "--" & wsp & Rest * Comment;
97 -- Get non-comment, non-blank line. Also skips "for " rep clauses
106 Line := Get_Line (InS);
109 and then not Match (Line, Wsp_For)
110 and then not Match (Line, Is_Cmnt)
114 elsif Match (Line, " -- End functions (note") then
120 -- Start of processing for XSinfo
124 Anchored_Mode := True;
126 if Argument_Count > 0 then
127 Create (Ofile, Out_File, Argument (1));
129 Create (Ofile, Out_File, "sinfo.h");
132 Open (InS, In_File, "sinfo.ads");
134 -- Write header to output file
137 Line := Get_Line (InS);
143 "-- C Header File ");
145 Match (Line, "--", "/*");
146 Match (Line, Rtab (2) * A & "--", M);
147 Replace (M, A & "*/");
148 Put_Line (Ofile, Line);
151 -- Skip to package line
155 exit when Match (Line, "package");
158 -- Skip to first node kind line
162 exit when Match (Line, Typ_Nod);
163 Put_Line (Ofile, Line);
166 Put_Line (Ofile, "");
169 -- Loop through node kind codes
174 if Match (Line, Get_Nam) then
175 Put_Line (Ofile, A & "#define N_" & Nam & ' ' & NKV);
177 exit when not Match (Term, ",");
180 Put_Line (Ofile, Line);
184 Put_Line (Ofile, "");
185 Put_Line (Ofile, A & "#define Number_Node_Kinds " & NKV);
187 -- Loop through subtype declarations
192 if not Match (Line, Sub_Typ) then
193 exit when Match (Line, " function");
194 Put_Line (Ofile, Line);
197 Put_Line (Ofile, A & "SUBTYPE (" & N & ", Node_Kind, ");
202 if Match (Line, No_Cont) then
203 Put_Line (Ofile, A & " " & N1 & ", " & N2 & ')');
208 if not Match (Line, Cont_N1) then
214 if not Match (Line, Cont_N2) then
218 Put_Line (Ofile, A & " " & N1 & ',');
219 Put_Line (Ofile, A & " " & N2 & ')');
224 -- Loop through functions. Note that this loop is terminated by
225 -- the call to Getfile encountering the end of functions sentinel
228 if Match (Line, Is_Func) then
230 if not Match (Line, Get_Arg) then
235 A & "INLINE " & Rpad (Rtn, 9)
236 & ' ' & Rpad (Nam, 30) & " (" & Arg & " N)");
238 Put_Line (Ofile, A & " { return " & Comment & " (N); }");
241 Put_Line (Ofile, Line);
249 Put_Line (Ofile, "");