|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT SYSTEM UTILITIES --
|
|
|
4 -- --
|
|
|
5 -- X S I N F O --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
|
9 -- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
|
|
|
10 -- --
|
|
|
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. --
|
|
|
20 -- --
|
|
|
21 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
23 -- --
|
|
|
24 ------------------------------------------------------------------------------
|
|
|
25
|
|
|
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)
|
|
|
29
|
|
|
30 -- Input files:
|
|
|
31
|
|
|
32 -- sinfo.ads Spec of Sinfo package
|
|
|
33
|
|
|
34 -- Output files:
|
|
|
35
|
|
|
36 -- sinfo.h Corresponding c header file
|
|
|
37
|
|
|
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.
|
|
|
40
|
|
|
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;
|
|
|
45
|
|
|
46 with GNAT.Spitbol; use GNAT.Spitbol;
|
|
|
47 with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns;
|
|
|
48
|
|
|
49 with CSinfo;
|
|
|
50
|
|
|
51 procedure XSinfo is
|
|
|
52
|
|
|
53 Done : exception;
|
|
|
54 Err : exception;
|
|
|
55
|
|
|
56 A : VString := Nul;
|
|
|
57 Arg : VString := Nul;
|
|
|
58 Comment : VString := Nul;
|
|
|
59 Line : VString := Nul;
|
|
|
60 N : VString := Nul;
|
|
|
61 N1, N2 : VString := Nul;
|
|
|
62 Nam : VString := Nul;
|
|
|
63 Rtn : VString := Nul;
|
|
|
64 Term : VString := Nul;
|
|
|
65
|
|
|
66 InS : File_Type;
|
|
|
67 Ofile : File_Type;
|
|
|
68
|
|
|
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
|
|
|
74 & Len (1) * Term;
|
|
|
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;
|
|
|
84
|
|
|
85 NKV : Natural;
|
|
|
86
|
|
|
87 M : Match_Result;
|
|
|
88
|
|
|
89 procedure Getline;
|
|
|
90 -- Get non-comment, non-blank line. Also skips "for " rep clauses
|
|
|
91
|
|
|
92 -------------
|
|
|
93 -- Getline --
|
|
|
94 -------------
|
|
|
95
|
|
|
96 procedure Getline is
|
|
|
97 begin
|
|
|
98 loop
|
|
|
99 Line := Get_Line (InS);
|
|
|
100
|
|
|
101 if Line /= ""
|
|
|
102 and then not Match (Line, Wsp_For)
|
|
|
103 and then not Match (Line, Is_Cmnt)
|
|
|
104 then
|
|
|
105 return;
|
|
|
106
|
|
|
107 elsif Match (Line, " -- End functions (note") then
|
|
|
108 raise Done;
|
|
|
109 end if;
|
|
|
110 end loop;
|
|
|
111 end Getline;
|
|
|
112
|
|
|
113 -- Start of processing for XSinfo
|
|
|
114
|
|
|
115 begin
|
|
|
116 -- First run CSinfo to check for errors. Note that CSinfo is also a
|
|
|
117 -- stand-alone program that can be run separately.
|
|
|
118
|
|
|
119 CSinfo;
|
|
|
120
|
|
|
121 Set_Exit_Status (1);
|
|
|
122 Anchored_Mode := True;
|
|
|
123
|
|
|
124 if Argument_Count > 0 then
|
|
|
125 Create (Ofile, Out_File, Argument (1));
|
|
|
126 else
|
|
|
127 Create (Ofile, Out_File, "sinfo.h");
|
|
|
128 end if;
|
|
|
129
|
|
|
130 Open (InS, In_File, "sinfo.ads");
|
|
|
131
|
|
|
132 -- Write header to output file
|
|
|
133
|
|
|
134 loop
|
|
|
135 Line := Get_Line (InS);
|
|
|
136 exit when Line = "";
|
|
|
137
|
|
|
138 Match
|
|
|
139 (Line,
|
|
|
140 "-- S p e c ",
|
|
|
141 "-- C Header File ");
|
|
|
142
|
|
|
143 Match (Line, "--", "/*");
|
|
|
144 Match (Line, Rtab (2) * A & "--", M);
|
|
|
145 Replace (M, A & "*/");
|
|
|
146 Put_Line (Ofile, Line);
|
|
|
147 end loop;
|
|
|
148
|
|
|
149 -- Skip to package line
|
|
|
150
|
|
|
151 loop
|
|
|
152 Getline;
|
|
|
153 exit when Match (Line, "package");
|
|
|
154 end loop;
|
|
|
155
|
|
|
156 -- Skip to first node kind line
|
|
|
157
|
|
|
158 loop
|
|
|
159 Getline;
|
|
|
160 exit when Match (Line, Typ_Nod);
|
|
|
161 Put_Line (Ofile, Line);
|
|
|
162 end loop;
|
|
|
163
|
|
|
164 Put_Line (Ofile, "");
|
|
|
165
|
|
|
166 Put_Line (Ofile, "#ifdef __cplusplus");
|
|
|
167 Put_Line (Ofile, "extern ""C"" {");
|
|
|
168 Put_Line (Ofile, "#endif");
|
|
|
169
|
|
|
170 NKV := 0;
|
|
|
171
|
|
|
172 -- Loop through node kind codes
|
|
|
173
|
|
|
174 loop
|
|
|
175 Getline;
|
|
|
176
|
|
|
177 if Match (Line, Get_Nam) then
|
|
|
178 Put_Line (Ofile, A & "#define N_" & Nam & ' ' & NKV);
|
|
|
179 NKV := NKV + 1;
|
|
|
180 exit when not Match (Term, ",");
|
|
|
181
|
|
|
182 else
|
|
|
183 Put_Line (Ofile, Line);
|
|
|
184 end if;
|
|
|
185 end loop;
|
|
|
186
|
|
|
187 Put_Line (Ofile, "");
|
|
|
188 Put_Line (Ofile, A & "#define Number_Node_Kinds " & NKV);
|
|
|
189
|
|
|
190 -- Loop through subtype declarations
|
|
|
191
|
|
|
192 loop
|
|
|
193 Getline;
|
|
|
194
|
|
|
195 if not Match (Line, Sub_Typ) then
|
|
|
196 exit when Match (Line, " function");
|
|
|
197 Put_Line (Ofile, Line);
|
|
|
198
|
|
|
199 else
|
|
|
200 Put_Line (Ofile, A & "SUBTYPE (" & N & ", Node_Kind, ");
|
|
|
201 Getline;
|
|
|
202
|
|
|
203 -- Normal case
|
|
|
204
|
|
|
205 if Match (Line, No_Cont) then
|
|
|
206 Put_Line (Ofile, A & " " & N1 & ", " & N2 & ')');
|
|
|
207
|
|
|
208 -- Continuation case
|
|
|
209
|
|
|
210 else
|
|
|
211 if not Match (Line, Cont_N1) then
|
|
|
212 raise Err;
|
|
|
213 end if;
|
|
|
214
|
|
|
215 Getline;
|
|
|
216
|
|
|
217 if not Match (Line, Cont_N2) then
|
|
|
218 raise Err;
|
|
|
219 end if;
|
|
|
220
|
|
|
221 Put_Line (Ofile, A & " " & N1 & ',');
|
|
|
222 Put_Line (Ofile, A & " " & N2 & ')');
|
|
|
223 end if;
|
|
|
224 end if;
|
|
|
225 end loop;
|
|
|
226
|
|
|
227 -- Loop through functions. Note that this loop is terminated by
|
|
|
228 -- the call to Getfile encountering the end of functions sentinel
|
|
|
229
|
|
|
230 loop
|
|
|
231 if Match (Line, Is_Func) then
|
|
|
232 Getline;
|
|
|
233 if not Match (Line, Get_Arg) then
|
|
|
234 raise Err;
|
|
|
235 end if;
|
|
|
236 Put_Line
|
|
|
237 (Ofile,
|
|
|
238 A & "INLINE " & Rpad (Rtn, 9)
|
|
|
239 & ' ' & Rpad (Nam, 30) & " (" & Arg & " N)");
|
|
|
240
|
|
|
241 Put_Line (Ofile, A & " { return " & Comment & " (N); }");
|
|
|
242
|
|
|
243 else
|
|
|
244 Put_Line (Ofile, Line);
|
|
|
245 end if;
|
|
|
246
|
|
|
247 Getline;
|
|
|
248 end loop;
|
|
|
249
|
|
|
250 -- Can't get here since above loop only left via raise
|
|
|
251
|
|
|
252 exception
|
|
|
253 when Done =>
|
|
|
254 Close (InS);
|
|
|
255 Put_Line (Ofile, "");
|
|
|
256 Put_Line (Ofile, "#ifdef __cplusplus");
|
|
|
257 Put_Line (Ofile, "}");
|
|
|
258 Put_Line (Ofile, "#endif");
|
|
|
259 Close (Ofile);
|
|
|
260 Set_Exit_Status (0);
|
|
|
261
|
|
|
262 end XSinfo;
|
