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;
60 Comment : VString := Nul;
61 Line : VString := Nul;
63 N1, N2 : VString := Nul;
66 Term : VString := Nul;
71 wsp : Pattern := Span (' ' & ASCII.HT);
72 Wsp_For : Pattern := wsp & "for";
73 Is_Cmnt : Pattern := wsp & "--";
74 Typ_Nod : Pattern := wsp * A & "type Node_Kind is";
75 Get_Nam : Pattern := wsp * A & "N_" & Break (",)") * Nam
77 Sub_Typ : Pattern := wsp * A & "subtype " & Break (' ') * N;
78 No_Cont : Pattern := wsp & Break (' ') * N1 & " .. " & Break (';') * N2;
79 Cont_N1 : Pattern := wsp & Break (' ') * N1 & " .." & Rpos (0);
80 Cont_N2 : Pattern := Span (' ') & Break (';') * N2;
81 Is_Func : Pattern := wsp * A & "function " & Rest * Nam;
82 Get_Arg : Pattern := wsp & "(N : " & Break (')') * Arg
83 & ") return " & Break (';') * Rtn
84 & ';' & wsp & "--" & wsp & Rest * Comment;
91 -- Get non-comment, non-blank line. Also skips "for " rep clauses
100 Line := Get_Line (InS);
103 and then not Match (Line, Wsp_For)
104 and then not Match (Line, Is_Cmnt)
108 elsif Match (Line, " -- End functions (note") then
114 -- Start of processing for XSinfo
118 Anchored_Mode := True;
120 if Argument_Count > 0 then
121 Create (Ofile, Out_File, Argument (1));
123 Create (Ofile, Out_File, "sinfo.h");
126 Open (InS, In_File, "sinfo.ads");
128 -- Write header to output file
131 Line := Get_Line (InS);
137 "-- C Header File ");
139 Match (Line, "--", "/*");
140 Match (Line, Rtab (2) * A & "--", M);
141 Replace (M, A & "*/");
142 Put_Line (Ofile, Line);
145 -- Skip to package line
149 exit when Match (Line, "package");
152 -- Skip to first node kind line
156 exit when Match (Line, Typ_Nod);
157 Put_Line (Ofile, Line);
160 Put_Line (Ofile, "");
163 -- Loop through node kind codes
168 if Match (Line, Get_Nam) then
169 Put_Line (Ofile, A & "#define N_" & Nam & ' ' & NKV);
171 exit when not Match (Term, ",");
174 Put_Line (Ofile, Line);
178 Put_Line (Ofile, "");
179 Put_Line (Ofile, A & "#define Number_Node_Kinds " & NKV);
181 -- Loop through subtype declarations
186 if not Match (Line, Sub_Typ) then
187 exit when Match (Line, " function");
188 Put_Line (Ofile, Line);
191 Put_Line (Ofile, A & "SUBTYPE (" & N & ", Node_Kind, ");
196 if Match (Line, No_Cont) then
197 Put_Line (Ofile, A & " " & N1 & ", " & N2 & ')');
202 if not Match (Line, Cont_N1) then
208 if not Match (Line, Cont_N2) then
212 Put_Line (Ofile, A & " " & N1 & ',');
213 Put_Line (Ofile, A & " " & N2 & ')');
218 -- Loop through functions. Note that this loop is terminated by
219 -- the call to Getfile encountering the end of functions sentinel
222 if Match (Line, Is_Func) then
224 if not Match (Line, Get_Arg) then
229 A & "INLINE " & Rpad (Rtn, 9)
230 & ' ' & Rpad (Nam, 30) & " (" & Arg & " N)");
232 Put_Line (Ofile, A & " { return " & Comment & " (N); }");
235 Put_Line (Ofile, Line);
243 Put_Line (Ofile, "");