]>
Commit | Line | Data |
---|---|---|
415dddc8 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT SYSTEM UTILITIES -- | |
4 | -- -- | |
5 | -- X S I N F O -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
4b490c1e | 9 | -- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- |
415dddc8 RK |
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- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
415dddc8 RK |
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 -- | |
b5c84c3c RD |
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. -- | |
415dddc8 RK |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
415dddc8 RK |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
448f2610 | 26 | -- Program to construct C header file sinfo.h (C version of sinfo.ads spec, |
415dddc8 RK |
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 | ||
448f2610 | 36 | -- sinfo.h Corresponding c header file |
415dddc8 | 37 | |
415dddc8 | 38 | -- An optional argument allows the specification of an output file name to |
448f2610 | 39 | -- override the default sinfo.h file name for the generated output file. |
415dddc8 RK |
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 | ||
d347f572 AC |
49 | with CSinfo; |
50 | ||
415dddc8 RK |
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; | |
415dddc8 | 64 | Term : VString := Nul; |
415dddc8 | 65 | |
f53f9dd7 RD |
66 | InS : File_Type; |
67 | Ofile : File_Type; | |
415dddc8 | 68 | |
34a343e6 RD |
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; | |
415dddc8 RK |
84 | |
85 | NKV : Natural; | |
86 | ||
87 | M : Match_Result; | |
88 | ||
415dddc8 | 89 | procedure Getline; |
84fdd8a3 AC |
90 | -- Get non-comment, non-blank line. Also skips "for " rep clauses |
91 | ||
92 | ------------- | |
93 | -- Getline -- | |
94 | ------------- | |
415dddc8 RK |
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 | |
d347f572 AC |
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 | ||
415dddc8 RK |
121 | Set_Exit_Status (1); |
122 | Anchored_Mode := True; | |
415dddc8 RK |
123 | |
124 | if Argument_Count > 0 then | |
125 | Create (Ofile, Out_File, Argument (1)); | |
126 | else | |
448f2610 | 127 | Create (Ofile, Out_File, "sinfo.h"); |
415dddc8 RK |
128 | end if; |
129 | ||
130 | Open (InS, In_File, "sinfo.ads"); | |
131 | ||
6cbcc541 | 132 | -- Write header to output file |
415dddc8 RK |
133 | |
134 | loop | |
135 | Line := Get_Line (InS); | |
136 | exit when Line = ""; | |
137 | ||
6cbcc541 GK |
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); | |
415dddc8 RK |
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, ""); | |
9e9bd455 LG |
165 | |
166 | Put_Line (Ofile, "#ifdef __cplusplus"); | |
167 | Put_Line (Ofile, "extern ""C"" {"); | |
168 | Put_Line (Ofile, "#endif"); | |
169 | ||
415dddc8 RK |
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; | |
da20aa43 RD |
249 | |
250 | -- Can't get here since above loop only left via raise | |
415dddc8 RK |
251 | |
252 | exception | |
253 | when Done => | |
d347f572 | 254 | Close (InS); |
415dddc8 | 255 | Put_Line (Ofile, ""); |
9e9bd455 LG |
256 | Put_Line (Ofile, "#ifdef __cplusplus"); |
257 | Put_Line (Ofile, "}"); | |
258 | Put_Line (Ofile, "#endif"); | |
d347f572 | 259 | Close (Ofile); |
415dddc8 RK |
260 | Set_Exit_Status (0); |
261 | ||
262 | end XSinfo; |