Commit | Line | Data |
---|---|---|
1101cb7b TT |
1 | #!/usr/bin/perl |
2 | ||
e2882c85 | 3 | # Copyright (C) 2013-2018 Free Software Foundation, Inc. |
1101cb7b TT |
4 | # |
5 | # This file is part of GDB. | |
6 | # | |
7 | # This program is free software; you can redistribute it and/or modify | |
8 | # it under the terms of the GNU General Public License as published by | |
9 | # the Free Software Foundation; either version 3 of the License, or | |
10 | # (at your option) any later version. | |
11 | # | |
12 | # This program is distributed in the hope that it will be useful, | |
13 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | # GNU General Public License for more details. | |
16 | # | |
17 | # You should have received a copy of the GNU General Public License | |
18 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | ||
21 | # Usage: | |
22 | # make-target-delegates target.h > target-delegates.c | |
23 | ||
24 | # The line we search for in target.h that marks where we should start | |
25 | # looking for methods. | |
26 | $TRIGGER = qr,^struct target_ops$,; | |
27 | # The end of the methods part. | |
28 | $ENDER = qr,^\s*};$,; | |
29 | ||
30 | # Match a C symbol. | |
31 | $SYMBOL = qr,[a-zA-Z_][a-zA-Z0-9_]*,; | |
32 | # Match the name part of a method in struct target_ops. | |
f6ac5f3d | 33 | $NAME_PART = qr,(?<name>${SYMBOL}+)\s,; |
a8bdc56b TT |
34 | # Match the arguments to a method. |
35 | $ARGS_PART = qr,(?<args>\(.*\)),; | |
36 | # We strip the indentation so here we only need the caret. | |
37 | $INTRO_PART = qr,^,; | |
1101cb7b | 38 | |
f6ac5f3d PA |
39 | $POINTER_PART = qr,\s*(\*)?\s*,; |
40 | ||
41 | # Match a C++ symbol, including scope operators and template | |
42 | # parameters. E.g., 'std::vector<something>'. | |
43 | $CP_SYMBOL = qr,[a-zA-Z_][a-zA-Z0-9_<>:]*,; | |
1101cb7b | 44 | # Match the return type when it is "ordinary". |
f6ac5f3d | 45 | $SIMPLE_RETURN_PART = qr,((struct|class|enum|union)\s+)?${CP_SYMBOL}+,; |
1101cb7b | 46 | # Match the return type when it is a VEC. |
f6ac5f3d PA |
47 | $VEC_RETURN_PART = qr,VEC\s*\([^\)]+\),; |
48 | ||
49 | # Match a return type. | |
50 | $RETURN_PART = qr,((const|volatile)\s+)?(${SIMPLE_RETURN_PART}|${VEC_RETURN_PART})${POINTER_PART},; | |
51 | ||
52 | # Match "virtual". | |
53 | $VIRTUAL_PART = qr,virtual\s,; | |
1101cb7b TT |
54 | |
55 | # Match the TARGET_DEFAULT_* attribute for a method. | |
56 | $TARGET_DEFAULT_PART = qr,TARGET_DEFAULT_(?<style>[A-Z_]+)\s*\((?<default_arg>.*)\),; | |
57 | ||
a8bdc56b TT |
58 | # Match the arguments and trailing attribute of a method definition. |
59 | # Note we don't match the trailing ";". | |
60 | $METHOD_TRAILER = qr,\s*${TARGET_DEFAULT_PART}$,; | |
61 | ||
62 | # Match an entire method definition. | |
f6ac5f3d | 63 | $METHOD = ($INTRO_PART . $VIRTUAL_PART . "(?<return_type>" . $RETURN_PART . ")" |
a8bdc56b TT |
64 | . $NAME_PART . $ARGS_PART |
65 | . $METHOD_TRAILER); | |
1101cb7b | 66 | |
a7068b60 TT |
67 | # Match TARGET_DEBUG_PRINTER in an argument type. |
68 | # This must match the whole "sub-expression" including the parens. | |
69 | # Reference $1 must refer to the function argument. | |
70 | $TARGET_DEBUG_PRINTER = qr,\s*TARGET_DEBUG_PRINTER\s*\(([^)]*)\)\s*,; | |
71 | ||
1101cb7b TT |
72 | sub trim($) { |
73 | my ($result) = @_; | |
a8bdc56b TT |
74 | |
75 | $result =~ s,^\s+,,; | |
76 | $result =~ s,\s+$,,; | |
77 | ||
1101cb7b TT |
78 | return $result; |
79 | } | |
80 | ||
81 | # Read from the input files until we find the trigger line. | |
82 | # Die if not found. | |
83 | sub find_trigger() { | |
84 | while (<>) { | |
85 | chomp; | |
86 | return if m/$TRIGGER/; | |
87 | } | |
88 | ||
89 | die "could not find trigger line\n"; | |
90 | } | |
91 | ||
a8bdc56b TT |
92 | # Scan target.h and return a list of possible target_ops method entries. |
93 | sub scan_target_h() { | |
94 | my $all_the_text = ''; | |
95 | ||
96 | find_trigger(); | |
97 | while (<>) { | |
98 | chomp; | |
99 | # Skip the open brace. | |
100 | next if /{/; | |
101 | last if m/$ENDER/; | |
102 | ||
f6ac5f3d | 103 | # Strip // comments. |
a8bdc56b TT |
104 | $_ =~ s,//.*$,,; |
105 | $_ = trim ($_); | |
106 | ||
107 | $all_the_text .= $_; | |
108 | } | |
109 | ||
110 | # Now strip out the C comments. | |
111 | $all_the_text =~ s,/\*(.*?)\*/,,g; | |
112 | ||
113 | return split (/;/, $all_the_text); | |
114 | } | |
115 | ||
1101cb7b TT |
116 | # Parse arguments into a list. |
117 | sub parse_argtypes($) { | |
118 | my ($typestr) = @_; | |
119 | ||
120 | $typestr =~ s/^\((.*)\)$/\1/; | |
121 | ||
122 | my (@typelist) = split (/,\s*/, $typestr); | |
123 | my (@result, $iter, $onetype); | |
124 | ||
125 | foreach $iter (@typelist) { | |
126 | if ($iter =~ m/^(enum\s+${SYMBOL}\s*)(${SYMBOL})?$/) { | |
127 | $onetype = $1; | |
c252925c | 128 | } elsif ($iter =~ m/^(.*(enum\s+)?${SYMBOL}.*(\s|\*|&))${SYMBOL}+$/) { |
1101cb7b TT |
129 | $onetype = $1; |
130 | } elsif ($iter eq 'void') { | |
131 | next; | |
132 | } else { | |
133 | $onetype = $iter; | |
134 | } | |
135 | push @result, trim ($onetype); | |
136 | } | |
137 | ||
138 | return @result; | |
139 | } | |
140 | ||
141 | sub dname($) { | |
142 | my ($name) = @_; | |
f6ac5f3d | 143 | return "target_ops::" . $name; |
1101cb7b TT |
144 | } |
145 | ||
146 | # Write function header given name, return type, and argtypes. | |
147 | # Returns a list of actual argument names. | |
f6ac5f3d PA |
148 | sub write_function_header($$$@) { |
149 | my ($decl, $name, $return_type, @argtypes) = @_; | |
150 | ||
151 | print $return_type; | |
152 | ||
153 | if ($decl) { | |
154 | if ($return_type !~ m,\*$,) { | |
155 | print " "; | |
156 | } | |
157 | } else { | |
158 | print "\n"; | |
159 | } | |
1101cb7b | 160 | |
1101cb7b TT |
161 | print $name . ' ('; |
162 | ||
163 | my $iter; | |
164 | my @argdecls; | |
165 | my @actuals; | |
166 | my $i = 0; | |
167 | foreach $iter (@argtypes) { | |
168 | my $val = $iter; | |
169 | ||
a7068b60 TT |
170 | $val =~ s/$TARGET_DEBUG_PRINTER//; |
171 | ||
c252925c | 172 | if ($iter !~ m,(\*|&)$,) { |
1101cb7b TT |
173 | $val .= ' '; |
174 | } | |
175 | ||
176 | my $vname; | |
f6ac5f3d | 177 | $vname .= "arg$i"; |
1101cb7b TT |
178 | $val .= $vname; |
179 | ||
180 | push @argdecls, $val; | |
181 | push @actuals, $vname; | |
182 | ++$i; | |
183 | } | |
184 | ||
f6ac5f3d PA |
185 | print join (', ', @argdecls) . ")"; |
186 | ||
187 | if ($decl) { | |
188 | print " override;\n"; | |
189 | } else { | |
190 | print "\n{\n"; | |
191 | } | |
1101cb7b TT |
192 | |
193 | return @actuals; | |
194 | } | |
195 | ||
f6ac5f3d PA |
196 | # Write out a declaration. |
197 | sub write_declaration($$@) { | |
198 | my ($name, $return_type, @argtypes) = @_; | |
199 | ||
200 | write_function_header (1, $name, $return_type, @argtypes); | |
201 | } | |
202 | ||
1101cb7b TT |
203 | # Write out a delegation function. |
204 | sub write_delegator($$@) { | |
205 | my ($name, $return_type, @argtypes) = @_; | |
206 | ||
f6ac5f3d PA |
207 | my (@names) = write_function_header (0, dname ($name), |
208 | $return_type, @argtypes); | |
1101cb7b | 209 | |
1101cb7b TT |
210 | print " "; |
211 | if ($return_type ne 'void') { | |
212 | print "return "; | |
213 | } | |
f6ac5f3d | 214 | print "this->beneath->" . $name . " ("; |
1101cb7b TT |
215 | print join (', ', @names); |
216 | print ");\n"; | |
217 | print "}\n\n"; | |
218 | } | |
219 | ||
220 | sub tdname ($) { | |
221 | my ($name) = @_; | |
f6ac5f3d | 222 | return "dummy_target::" . $name; |
1101cb7b TT |
223 | } |
224 | ||
225 | # Write out a default function. | |
226 | sub write_tdefault($$$$@) { | |
227 | my ($content, $style, $name, $return_type, @argtypes) = @_; | |
228 | ||
f6ac5f3d PA |
229 | my (@names) = write_function_header (0, tdname ($name), |
230 | $return_type, @argtypes); | |
1101cb7b | 231 | |
f6ac5f3d PA |
232 | if ($style eq 'FUNC') { |
233 | print " "; | |
234 | if ($return_type ne 'void') { | |
235 | print "return "; | |
236 | } | |
237 | print $content . " (this"; | |
238 | if (@names) { | |
239 | print ", "; | |
240 | } | |
241 | print join (', ', @names); | |
242 | print ");\n"; | |
243 | } elsif ($style eq 'RETURN') { | |
1101cb7b TT |
244 | print " return $content;\n"; |
245 | } elsif ($style eq 'NORETURN') { | |
246 | print " $content;\n"; | |
247 | } elsif ($style eq 'IGNORE') { | |
248 | # Nothing. | |
249 | } else { | |
250 | die "unrecognized style: $style\n"; | |
251 | } | |
252 | ||
253 | print "}\n\n"; | |
254 | ||
255 | return tdname ($name); | |
256 | } | |
257 | ||
a7068b60 TT |
258 | sub munge_type($) { |
259 | my ($typename) = @_; | |
260 | my ($result); | |
261 | ||
262 | if ($typename =~ m/$TARGET_DEBUG_PRINTER/) { | |
263 | $result = $1; | |
264 | } else { | |
265 | ($result = $typename) =~ s/\s+$//; | |
10f64178 | 266 | $result =~ s/[ ()<>:]/_/g; |
a7068b60 | 267 | $result =~ s/[*]/p/g; |
c252925c | 268 | $result =~ s/&/r/g; |
10f64178 PA |
269 | |
270 | # Identifers with double underscores are reserved to the C++ | |
271 | # implementation. | |
272 | $result =~ s/_+/_/g; | |
273 | ||
274 | # Avoid ending the function name with underscore, for | |
275 | # cosmetics. Trailing underscores appear after munging types | |
276 | # with template parameters, like e.g. "foo<int>". | |
277 | $result =~ s/_$//g; | |
278 | ||
a7068b60 TT |
279 | $result = 'target_debug_print_' . $result; |
280 | } | |
281 | ||
282 | return $result; | |
283 | } | |
284 | ||
285 | # Write out a debug method. | |
f6ac5f3d PA |
286 | sub write_debugmethod($$$@) { |
287 | my ($content, $name, $return_type, @argtypes) = @_; | |
a7068b60 | 288 | |
f6ac5f3d | 289 | my ($debugname) = "debug_target::" . $name; |
a7068b60 | 290 | my ($targetname) = $name; |
a7068b60 | 291 | |
f6ac5f3d | 292 | my (@names) = write_function_header (0, $debugname, $return_type, @argtypes); |
a7068b60 TT |
293 | |
294 | if ($return_type ne 'void') { | |
295 | print " $return_type result;\n"; | |
296 | } | |
297 | ||
f6ac5f3d | 298 | print " fprintf_unfiltered (gdb_stdlog, \"-> %s->$name (...)\\n\", this->beneath->shortname ());\n"; |
a7068b60 TT |
299 | |
300 | # Delegate to the beneath target. | |
301 | print " "; | |
302 | if ($return_type ne 'void') { | |
303 | print "result = "; | |
304 | } | |
f6ac5f3d PA |
305 | print "this->beneath->" . $name . " ("; |
306 | print join (', ', @names); | |
a7068b60 TT |
307 | print ");\n"; |
308 | ||
309 | # Now print the arguments. | |
f6ac5f3d | 310 | print " fprintf_unfiltered (gdb_stdlog, \"<- %s->$name (\", this->beneath->shortname ());\n"; |
a7068b60 | 311 | for my $i (0 .. $#argtypes) { |
f6ac5f3d PA |
312 | if ($i > 0) { |
313 | print " fputs_unfiltered (\", \", gdb_stdlog);\n" | |
314 | } | |
a7068b60 | 315 | my $printer = munge_type ($argtypes[$i]); |
f6ac5f3d | 316 | print " $printer ($names[$i]);\n"; |
a7068b60 TT |
317 | } |
318 | if ($return_type ne 'void') { | |
319 | print " fputs_unfiltered (\") = \", gdb_stdlog);\n"; | |
320 | my $printer = munge_type ($return_type); | |
321 | print " $printer (result);\n"; | |
322 | print " fputs_unfiltered (\"\\n\", gdb_stdlog);\n"; | |
323 | } else { | |
324 | print " fputs_unfiltered (\")\\n\", gdb_stdlog);\n"; | |
325 | } | |
326 | ||
327 | if ($return_type ne 'void') { | |
328 | print " return result;\n"; | |
329 | } | |
330 | ||
331 | print "}\n\n"; | |
332 | ||
333 | return $debugname; | |
334 | } | |
335 | ||
1101cb7b TT |
336 | print "/* THIS FILE IS GENERATED -*- buffer-read-only: t -*- */\n"; |
337 | print "/* vi:set ro: */\n\n"; | |
338 | print "/* To regenerate this file, run:*/\n"; | |
339 | print "/* make-target-delegates target.h > target-delegates.c */\n"; | |
f6ac5f3d | 340 | print "\n"; |
1101cb7b | 341 | |
a8bdc56b TT |
342 | @lines = scan_target_h(); |
343 | ||
1101cb7b | 344 | @delegators = (); |
f6ac5f3d PA |
345 | @return_types = (); |
346 | @tdefaults = (); | |
347 | @styles = (); | |
348 | @argtypes_array = (); | |
349 | ||
a8bdc56b TT |
350 | foreach $current_line (@lines) { |
351 | next unless $current_line =~ m/$METHOD/; | |
1101cb7b | 352 | |
f6ac5f3d PA |
353 | my $name = $+{name}; |
354 | my $current_line = $+{args}; | |
355 | my $return_type = trim ($+{return_type}); | |
356 | my $current_args = $+{args}; | |
357 | my $tdefault = $+{default_arg}; | |
358 | my $style = $+{style}; | |
1101cb7b | 359 | |
f6ac5f3d | 360 | my @argtypes = parse_argtypes ($current_args); |
1101cb7b | 361 | |
f6ac5f3d | 362 | push @delegators, $name; |
1101cb7b | 363 | |
f6ac5f3d PA |
364 | $return_types{$name} = $return_type; |
365 | $tdefaults{$name} = $tdefault; | |
366 | $styles{$name} = $style; | |
367 | $argtypes_array{$name} = \@argtypes; | |
368 | } | |
1101cb7b | 369 | |
f6ac5f3d PA |
370 | sub print_class($) { |
371 | my ($name) = @_; | |
a7068b60 | 372 | |
f6ac5f3d PA |
373 | print "struct " . $name . " : public target_ops\n"; |
374 | print "{\n"; | |
375 | print " $name ();\n"; | |
376 | print "\n"; | |
377 | print " const char *shortname () override;\n"; | |
378 | print " const char *longname () override;\n"; | |
379 | print " const char *doc () override;\n"; | |
380 | print "\n"; | |
381 | ||
382 | for $name (@delegators) { | |
383 | my $return_type = $return_types{$name}; | |
384 | my @argtypes = @{$argtypes_array{$name}}; | |
385 | ||
386 | print " "; | |
387 | write_declaration ($name, $return_type, @argtypes); | |
1101cb7b | 388 | } |
f6ac5f3d PA |
389 | |
390 | print "};\n\n"; | |
1101cb7b TT |
391 | } |
392 | ||
f6ac5f3d PA |
393 | print_class ("dummy_target"); |
394 | print_class ("debug_target"); | |
1101cb7b | 395 | |
f6ac5f3d PA |
396 | for $name (@delegators) { |
397 | my $tdefault = $tdefaults{$name}; | |
398 | my $return_type = $return_types{$name}; | |
399 | my $style = $styles{$name}; | |
400 | my @argtypes = @{$argtypes_array{$name}}; | |
1101cb7b | 401 | |
f6ac5f3d | 402 | write_delegator ($name, $return_type, @argtypes); |
1101cb7b | 403 | |
f6ac5f3d | 404 | write_tdefault ($tdefault, $style, $name, $return_type, @argtypes); |
a7068b60 | 405 | |
f6ac5f3d | 406 | write_debugmethod ($tdefault, $name, $return_type, @argtypes); |
a7068b60 | 407 | } |