1 ------------------------------------------------------------------------------
3 -- GNAT SYSTEM UTILITIES --
9 -- Copyright (C) 1992-2011, 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 -- An optional argument allows the specification of an output file name to
39 -- override the default sinfo.h file name for the generated output file.
41 with Ada.Command_Line; use Ada.Command_Line;
42 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
43 with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
44 with Ada.Text_IO; use Ada.Text_IO;
46 with GNAT.Spitbol; use GNAT.Spitbol;
47 with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns;
58 Comment : VString := Nul;
59 Line : VString := Nul;
61 N1, N2 : VString := Nul;
64 Term : VString := Nul;
69 wsp : constant Pattern := Span (' ' & ASCII.HT);
70 Wsp_For : constant Pattern := wsp & "for";
71 Is_Cmnt : constant Pattern := wsp & "--";
72 Typ_Nod : constant Pattern := wsp * A & "type Node_Kind is";
73 Get_Nam : constant Pattern := wsp * A & "N_" & Break (",)") * Nam
75 Sub_Typ : constant Pattern := wsp * A & "subtype " & Break (' ') * N;
76 No_Cont : constant Pattern := wsp & Break (' ') * N1
77 & " .. " & Break (';') * N2;
78 Cont_N1 : constant Pattern := wsp & Break (' ') * N1 & " .." & Rpos (0);
79 Cont_N2 : constant Pattern := Span (' ') & Break (';') * N2;
80 Is_Func : constant Pattern := wsp * A & "function " & Rest * Nam;
81 Get_Arg : constant Pattern := wsp & "(N : " & Break (')') * Arg
82 & ") return " & Break (';') * Rtn
83 & ';' & wsp & "--" & wsp & Rest * Comment;
90 -- Get non-comment, non-blank line. Also skips "for " rep clauses
99 Line := Get_Line (InS);
102 and then not Match (Line, Wsp_For)
103 and then not Match (Line, Is_Cmnt)
107 elsif Match (Line, " -- End functions (note") then
113 -- Start of processing for XSinfo
116 -- First run CSinfo to check for errors. Note that CSinfo is also a
117 -- stand-alone program that can be run separately.
122 Anchored_Mode := True;
124 if Argument_Count > 0 then
125 Create (Ofile, Out_File, Argument (1));
127 Create (Ofile, Out_File, "sinfo.h");
130 Open (InS, In_File, "sinfo.ads");
132 -- Write header to output file
135 Line := Get_Line (InS);
141 "-- C Header File ");
143 Match (Line, "--", "/*");
144 Match (Line, Rtab (2) * A & "--", M);
145 Replace (M, A & "*/");
146 Put_Line (Ofile, Line);
149 -- Skip to package line
153 exit when Match (Line, "package");
156 -- Skip to first node kind line
160 exit when Match (Line, Typ_Nod);
161 Put_Line (Ofile, Line);
164 Put_Line (Ofile, "");
166 Put_Line (Ofile, "#ifdef __cplusplus");
167 Put_Line (Ofile, "extern ""C"" {");
168 Put_Line (Ofile, "#endif");
172 -- Loop through node kind codes
177 if Match (Line, Get_Nam) then
178 Put_Line (Ofile, A & "#define N_" & Nam & ' ' & NKV);
180 exit when not Match (Term, ",");
183 Put_Line (Ofile, Line);
187 Put_Line (Ofile, "");
188 Put_Line (Ofile, A & "#define Number_Node_Kinds " & NKV);
190 -- Loop through subtype declarations
195 if not Match (Line, Sub_Typ) then
196 exit when Match (Line, " function");
197 Put_Line (Ofile, Line);
200 Put_Line (Ofile, A & "SUBTYPE (" & N & ", Node_Kind, ");
205 if Match (Line, No_Cont) then
206 Put_Line (Ofile, A & " " & N1 & ", " & N2 & ')');
211 if not Match (Line, Cont_N1) then
217 if not Match (Line, Cont_N2) then
221 Put_Line (Ofile, A & " " & N1 & ',');
222 Put_Line (Ofile, A & " " & N2 & ')');
227 -- Loop through functions. Note that this loop is terminated by
228 -- the call to Getfile encountering the end of functions sentinel
231 if Match (Line, Is_Func) then
233 if not Match (Line, Get_Arg) then
238 A & "INLINE " & Rpad (Rtn, 9)
239 & ' ' & Rpad (Nam, 30) & " (" & Arg & " N)");
241 Put_Line (Ofile, A & " { return " & Comment & " (N); }");
244 Put_Line (Ofile, Line);
250 -- Can't get here since above loop only left via raise
255 Put_Line (Ofile, "");
256 Put_Line (Ofile, "#ifdef __cplusplus");
257 Put_Line (Ofile, "}");
258 Put_Line (Ofile, "#endif");