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 | 104 | $_ =~ s,//.*$,,; |
a8bdc56b TT |
105 | |
106 | $all_the_text .= $_; | |
107 | } | |
108 | ||
109 | # Now strip out the C comments. | |
110 | $all_the_text =~ s,/\*(.*?)\*/,,g; | |
111 | ||
ad6a4e2d PA |
112 | # Replace sequences of tabs and/or whitespace with a single |
113 | # whitespace character. We need the whitespace because the method | |
114 | # may have been split between multiple lines, like e.g.: | |
115 | # | |
116 | # virtual std::vector<long_type_name> | |
117 | # my_long_method_name () | |
118 | # TARGET_DEFAULT_IGNORE (); | |
119 | # | |
120 | # If we didn't preserve the whitespace, then we'd end up with: | |
121 | # | |
122 | # virtual std::vector<long_type_name>my_long_method_name ()TARGET_DEFAULT_IGNORE () | |
123 | # | |
124 | # ... which wouldn't later be parsed correctly. | |
125 | $all_the_text =~ s/[\t\s]+/ /g; | |
126 | ||
a8bdc56b TT |
127 | return split (/;/, $all_the_text); |
128 | } | |
129 | ||
1101cb7b TT |
130 | # Parse arguments into a list. |
131 | sub parse_argtypes($) { | |
132 | my ($typestr) = @_; | |
133 | ||
134 | $typestr =~ s/^\((.*)\)$/\1/; | |
135 | ||
136 | my (@typelist) = split (/,\s*/, $typestr); | |
137 | my (@result, $iter, $onetype); | |
138 | ||
139 | foreach $iter (@typelist) { | |
140 | if ($iter =~ m/^(enum\s+${SYMBOL}\s*)(${SYMBOL})?$/) { | |
141 | $onetype = $1; | |
c252925c | 142 | } elsif ($iter =~ m/^(.*(enum\s+)?${SYMBOL}.*(\s|\*|&))${SYMBOL}+$/) { |
1101cb7b TT |
143 | $onetype = $1; |
144 | } elsif ($iter eq 'void') { | |
145 | next; | |
146 | } else { | |
147 | $onetype = $iter; | |
148 | } | |
149 | push @result, trim ($onetype); | |
150 | } | |
151 | ||
152 | return @result; | |
153 | } | |
154 | ||
155 | sub dname($) { | |
156 | my ($name) = @_; | |
f6ac5f3d | 157 | return "target_ops::" . $name; |
1101cb7b TT |
158 | } |
159 | ||
160 | # Write function header given name, return type, and argtypes. | |
161 | # Returns a list of actual argument names. | |
f6ac5f3d PA |
162 | sub write_function_header($$$@) { |
163 | my ($decl, $name, $return_type, @argtypes) = @_; | |
164 | ||
165 | print $return_type; | |
166 | ||
167 | if ($decl) { | |
168 | if ($return_type !~ m,\*$,) { | |
169 | print " "; | |
170 | } | |
171 | } else { | |
172 | print "\n"; | |
173 | } | |
1101cb7b | 174 | |
1101cb7b TT |
175 | print $name . ' ('; |
176 | ||
177 | my $iter; | |
178 | my @argdecls; | |
179 | my @actuals; | |
180 | my $i = 0; | |
181 | foreach $iter (@argtypes) { | |
182 | my $val = $iter; | |
183 | ||
a7068b60 TT |
184 | $val =~ s/$TARGET_DEBUG_PRINTER//; |
185 | ||
c252925c | 186 | if ($iter !~ m,(\*|&)$,) { |
1101cb7b TT |
187 | $val .= ' '; |
188 | } | |
189 | ||
190 | my $vname; | |
f6ac5f3d | 191 | $vname .= "arg$i"; |
1101cb7b TT |
192 | $val .= $vname; |
193 | ||
194 | push @argdecls, $val; | |
195 | push @actuals, $vname; | |
196 | ++$i; | |
197 | } | |
198 | ||
f6ac5f3d PA |
199 | print join (', ', @argdecls) . ")"; |
200 | ||
201 | if ($decl) { | |
202 | print " override;\n"; | |
203 | } else { | |
204 | print "\n{\n"; | |
205 | } | |
1101cb7b TT |
206 | |
207 | return @actuals; | |
208 | } | |
209 | ||
f6ac5f3d PA |
210 | # Write out a declaration. |
211 | sub write_declaration($$@) { | |
212 | my ($name, $return_type, @argtypes) = @_; | |
213 | ||
214 | write_function_header (1, $name, $return_type, @argtypes); | |
215 | } | |
216 | ||
1101cb7b TT |
217 | # Write out a delegation function. |
218 | sub write_delegator($$@) { | |
219 | my ($name, $return_type, @argtypes) = @_; | |
220 | ||
f6ac5f3d PA |
221 | my (@names) = write_function_header (0, dname ($name), |
222 | $return_type, @argtypes); | |
1101cb7b | 223 | |
1101cb7b TT |
224 | print " "; |
225 | if ($return_type ne 'void') { | |
226 | print "return "; | |
227 | } | |
b6a8c27b | 228 | print "this->beneath ()->" . $name . " ("; |
1101cb7b TT |
229 | print join (', ', @names); |
230 | print ");\n"; | |
231 | print "}\n\n"; | |
232 | } | |
233 | ||
234 | sub tdname ($) { | |
235 | my ($name) = @_; | |
f6ac5f3d | 236 | return "dummy_target::" . $name; |
1101cb7b TT |
237 | } |
238 | ||
239 | # Write out a default function. | |
240 | sub write_tdefault($$$$@) { | |
241 | my ($content, $style, $name, $return_type, @argtypes) = @_; | |
242 | ||
f6ac5f3d PA |
243 | my (@names) = write_function_header (0, tdname ($name), |
244 | $return_type, @argtypes); | |
1101cb7b | 245 | |
f6ac5f3d PA |
246 | if ($style eq 'FUNC') { |
247 | print " "; | |
248 | if ($return_type ne 'void') { | |
249 | print "return "; | |
250 | } | |
251 | print $content . " (this"; | |
252 | if (@names) { | |
253 | print ", "; | |
254 | } | |
255 | print join (', ', @names); | |
256 | print ");\n"; | |
257 | } elsif ($style eq 'RETURN') { | |
1101cb7b TT |
258 | print " return $content;\n"; |
259 | } elsif ($style eq 'NORETURN') { | |
260 | print " $content;\n"; | |
261 | } elsif ($style eq 'IGNORE') { | |
262 | # Nothing. | |
263 | } else { | |
264 | die "unrecognized style: $style\n"; | |
265 | } | |
266 | ||
267 | print "}\n\n"; | |
268 | ||
269 | return tdname ($name); | |
270 | } | |
271 | ||
a7068b60 TT |
272 | sub munge_type($) { |
273 | my ($typename) = @_; | |
274 | my ($result); | |
275 | ||
276 | if ($typename =~ m/$TARGET_DEBUG_PRINTER/) { | |
277 | $result = $1; | |
278 | } else { | |
279 | ($result = $typename) =~ s/\s+$//; | |
10f64178 | 280 | $result =~ s/[ ()<>:]/_/g; |
a7068b60 | 281 | $result =~ s/[*]/p/g; |
c252925c | 282 | $result =~ s/&/r/g; |
10f64178 PA |
283 | |
284 | # Identifers with double underscores are reserved to the C++ | |
285 | # implementation. | |
286 | $result =~ s/_+/_/g; | |
287 | ||
288 | # Avoid ending the function name with underscore, for | |
289 | # cosmetics. Trailing underscores appear after munging types | |
290 | # with template parameters, like e.g. "foo<int>". | |
291 | $result =~ s/_$//g; | |
292 | ||
a7068b60 TT |
293 | $result = 'target_debug_print_' . $result; |
294 | } | |
295 | ||
296 | return $result; | |
297 | } | |
298 | ||
299 | # Write out a debug method. | |
f6ac5f3d PA |
300 | sub write_debugmethod($$$@) { |
301 | my ($content, $name, $return_type, @argtypes) = @_; | |
a7068b60 | 302 | |
f6ac5f3d | 303 | my ($debugname) = "debug_target::" . $name; |
a7068b60 | 304 | my ($targetname) = $name; |
a7068b60 | 305 | |
f6ac5f3d | 306 | my (@names) = write_function_header (0, $debugname, $return_type, @argtypes); |
a7068b60 TT |
307 | |
308 | if ($return_type ne 'void') { | |
309 | print " $return_type result;\n"; | |
310 | } | |
311 | ||
b6a8c27b | 312 | print " fprintf_unfiltered (gdb_stdlog, \"-> %s->$name (...)\\n\", this->beneath ()->shortname ());\n"; |
a7068b60 TT |
313 | |
314 | # Delegate to the beneath target. | |
315 | print " "; | |
316 | if ($return_type ne 'void') { | |
317 | print "result = "; | |
318 | } | |
b6a8c27b | 319 | print "this->beneath ()->" . $name . " ("; |
f6ac5f3d | 320 | print join (', ', @names); |
a7068b60 TT |
321 | print ");\n"; |
322 | ||
323 | # Now print the arguments. | |
b6a8c27b | 324 | print " fprintf_unfiltered (gdb_stdlog, \"<- %s->$name (\", this->beneath ()->shortname ());\n"; |
a7068b60 | 325 | for my $i (0 .. $#argtypes) { |
f6ac5f3d PA |
326 | if ($i > 0) { |
327 | print " fputs_unfiltered (\", \", gdb_stdlog);\n" | |
328 | } | |
a7068b60 | 329 | my $printer = munge_type ($argtypes[$i]); |
f6ac5f3d | 330 | print " $printer ($names[$i]);\n"; |
a7068b60 TT |
331 | } |
332 | if ($return_type ne 'void') { | |
333 | print " fputs_unfiltered (\") = \", gdb_stdlog);\n"; | |
334 | my $printer = munge_type ($return_type); | |
335 | print " $printer (result);\n"; | |
336 | print " fputs_unfiltered (\"\\n\", gdb_stdlog);\n"; | |
337 | } else { | |
338 | print " fputs_unfiltered (\")\\n\", gdb_stdlog);\n"; | |
339 | } | |
340 | ||
341 | if ($return_type ne 'void') { | |
342 | print " return result;\n"; | |
343 | } | |
344 | ||
345 | print "}\n\n"; | |
346 | ||
347 | return $debugname; | |
348 | } | |
349 | ||
1101cb7b TT |
350 | print "/* THIS FILE IS GENERATED -*- buffer-read-only: t -*- */\n"; |
351 | print "/* vi:set ro: */\n\n"; | |
352 | print "/* To regenerate this file, run:*/\n"; | |
353 | print "/* make-target-delegates target.h > target-delegates.c */\n"; | |
f6ac5f3d | 354 | print "\n"; |
1101cb7b | 355 | |
a8bdc56b TT |
356 | @lines = scan_target_h(); |
357 | ||
1101cb7b | 358 | @delegators = (); |
f6ac5f3d PA |
359 | @return_types = (); |
360 | @tdefaults = (); | |
361 | @styles = (); | |
362 | @argtypes_array = (); | |
363 | ||
a8bdc56b | 364 | foreach $current_line (@lines) { |
ad6a4e2d PA |
365 | # See comments in scan_target_h. Here we strip away the leading |
366 | # and trailing whitespace. | |
367 | $current_line = trim ($current_line); | |
368 | ||
a8bdc56b | 369 | next unless $current_line =~ m/$METHOD/; |
1101cb7b | 370 | |
f6ac5f3d PA |
371 | my $name = $+{name}; |
372 | my $current_line = $+{args}; | |
373 | my $return_type = trim ($+{return_type}); | |
374 | my $current_args = $+{args}; | |
375 | my $tdefault = $+{default_arg}; | |
376 | my $style = $+{style}; | |
1101cb7b | 377 | |
f6ac5f3d | 378 | my @argtypes = parse_argtypes ($current_args); |
1101cb7b | 379 | |
f6ac5f3d | 380 | push @delegators, $name; |
1101cb7b | 381 | |
f6ac5f3d PA |
382 | $return_types{$name} = $return_type; |
383 | $tdefaults{$name} = $tdefault; | |
384 | $styles{$name} = $style; | |
385 | $argtypes_array{$name} = \@argtypes; | |
386 | } | |
1101cb7b | 387 | |
f6ac5f3d PA |
388 | sub print_class($) { |
389 | my ($name) = @_; | |
a7068b60 | 390 | |
f6ac5f3d PA |
391 | print "struct " . $name . " : public target_ops\n"; |
392 | print "{\n"; | |
393 | print " $name ();\n"; | |
394 | print "\n"; | |
d9f719f1 | 395 | print " const target_info &info () const override;\n"; |
f6ac5f3d PA |
396 | print "\n"; |
397 | ||
398 | for $name (@delegators) { | |
399 | my $return_type = $return_types{$name}; | |
400 | my @argtypes = @{$argtypes_array{$name}}; | |
401 | ||
402 | print " "; | |
403 | write_declaration ($name, $return_type, @argtypes); | |
1101cb7b | 404 | } |
f6ac5f3d PA |
405 | |
406 | print "};\n\n"; | |
1101cb7b TT |
407 | } |
408 | ||
f6ac5f3d PA |
409 | print_class ("dummy_target"); |
410 | print_class ("debug_target"); | |
1101cb7b | 411 | |
f6ac5f3d PA |
412 | for $name (@delegators) { |
413 | my $tdefault = $tdefaults{$name}; | |
414 | my $return_type = $return_types{$name}; | |
415 | my $style = $styles{$name}; | |
416 | my @argtypes = @{$argtypes_array{$name}}; | |
1101cb7b | 417 | |
f6ac5f3d | 418 | write_delegator ($name, $return_type, @argtypes); |
1101cb7b | 419 | |
f6ac5f3d | 420 | write_tdefault ($tdefault, $style, $name, $return_type, @argtypes); |
a7068b60 | 421 | |
f6ac5f3d | 422 | write_debugmethod ($tdefault, $name, $return_type, @argtypes); |
a7068b60 | 423 | } |