1# Copyright (C) 2013-2020 Free Software Foundation, Inc.
2
3# This program is free software; you can redistribute it and/or modify
4# it under the terms of the GNU General Public License as published by
5# the Free Software Foundation; either version 3 of the License, or
6# (at your option) any later version.
7#
8# This program is distributed in the hope that it will be useful,
9# but WITHOUT ANY WARRANTY; without even the implied warranty of
10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11# GNU General Public License for more details.
12#
13# You should have received a copy of the GNU General Public License
14# along with this program.  If not, see <http://www.gnu.org/licenses/>.
15#
16# Notes:
17# 1) This follows a Python convention for marking internal vs public functions.
18# Internal functions are prefixed with "_".
19
20# A simple testcase generator.
21#
22# Usage Notes:
23#
24# 1) The length of each parameter list must either be one, in which case the
25# same value is used for each run, or the length must match all other
26# parameters of length greater than one.
27#
28# 2) Values for parameters that vary across runs must appear in increasing
29# order.  E.g. nr_gen_shlibs = { 0 1 10 } is good, { 1 0 10 } is bad.
30# This rule simplifies the code a bit, without being onerous on the user:
31#  a) Report generation doesn't have to sort the output by run, it'll already
32#  be sorted.
33#  b) In the static object file case, the last run can be used used to generate
34#  all the source files.
35#
36# TODO:
37# 1) have functions call each other within an objfile and across
38#    objfiles to measure things like backtrace times
39# 2) enums
40#
41# Implementation Notes:
42#
43# 1) The implementation would be a bit simpler if we could assume Tcl 8.5.
44#    Then we could use a dictionary to record the testcase instead of an array.
45#    With the array we use here, there is only one copy of it and instead of
46#    passing its value we pass its name.  Yay Tcl.  An alternative is to just
47#    use a global variable.
48#
49# 2) Because these programs can be rather large, we try to avoid recompilation
50#    where we can.  We don't have a makefile: we could generate one but it's
51#    not clear that's simpler than our chosen mechanism which is to record
52#    sums of all the inputs, and detect if an input has changed that way.
53
54if ![info exists CAT_PROGRAM] {
55    set CAT_PROGRAM "/bin/cat"
56}
57
58# TODO(dje): Time md5sum vs sha1sum with our testcases.
59if ![info exists SHA1SUM_PROGRAM] {
60    set SHA1SUM_PROGRAM "/usr/bin/sha1sum"
61}
62
63namespace eval GenPerfTest {
64
65    # The default level of compilation parallelism we support.
66    set DEFAULT_PERF_TEST_COMPILE_PARALLELISM 10
67
68    # The language of the test.
69    set DEFAULT_LANGUAGE "c"
70
71    # Extra source files for the binary.
72    # This must at least include the file with main(),
73    # and each test must supply its own.
74    set DEFAULT_BINARY_EXTRA_SOURCES {}
75
76    # Header files used by generated files and extra sources.
77    set DEFAULT_BINARY_EXTRA_HEADERS {}
78
79    # Extra source files for each generated shlib.
80    # The compiler passes -DSHLIB=NNN which the source can use, for example,
81    # to define unique symbols for each shlib.
82    set DEFAULT_GEN_SHLIB_EXTRA_SOURCES {}
83
84    # Header files used by generated files and extra sources.
85    set DEFAULT_GEN_SHLIB_EXTRA_HEADERS {}
86
87    # Source files for a tail shlib, or empty if none.
88    # This library is loaded after all other shlibs (except any system shlibs
89    # like libstdc++).  It is useful for exercising issues that can appear
90    # with system shlibs, without having to cope with implementation details
91    # and bugs in system shlibs.  E.g., gcc pr 65669.
92    set DEFAULT_TAIL_SHLIB_SOURCES {}
93
94    # Header files for the tail shlib.
95    set DEFAULT_TAIL_SHLIB_HEADERS {}
96
97    # The number of shared libraries to create.
98    set DEFAULT_NR_GEN_SHLIBS 0
99
100    # The number of compunits in each objfile.
101    set DEFAULT_NR_COMPUNITS 1
102
103    # The number of public globals in each compunit.
104    set DEFAULT_NR_EXTERN_GLOBALS 1
105
106    # The number of static globals in each compunit.
107    set DEFAULT_NR_STATIC_GLOBALS 1
108
109    # The number of public functions in each compunit.
110    set DEFAULT_NR_EXTERN_FUNCTIONS 1
111
112    # The number of static functions in each compunit.
113    set DEFAULT_NR_STATIC_FUNCTIONS 1
114
115    # Class generation.
116    # This is only used if the selected language permits it.
117    # The class specs here are used for each compunit.
118    # Additional flexibility can be added as needed, but for now KISS.
119    #
120    # key/value list of:
121    # count: number of classes
122    #   Default: 1
123    # name: list of namespaces and class name prefix
124    #   E.g., { ns0 ns1 foo } -> ns0::ns1::foo_<cu#>_{0,1,...}
125    #   There is no default, this value must be specified.
126    # nr_members: number of members
127    #   Default: 0
128    # nr_static_members: number of static members
129    #   Default: 0
130    # nr_methods: number of methods
131    #   Default: 0
132    # nr_inline_methods: number of inline methods
133    #   Default: 0
134    # nr_static_methods: number of static methods
135    #   Default: 0
136    # nr_static_inline_methods: number of static inline methods
137    #   Default: 0
138    #
139    # E.g.,
140    # class foo {};
141    # namespace ns1 { class foo {}; }
142    # namespace ns2 { class bar {}; }
143    # would be represented as
144    # {
145    #   { count 1 name { foo } }
146    #   { count 1 name { ns1 foo } }
147    #   { count 1 name { ns2 bar } }
148    # }
149    # The actual generated class names will be
150    # cu_N_foo_0, ns1::cu_N_foo_0, ns2::cu_N_bar_0
151    # where "N" is the CU number.
152    #
153    # To keep things simple for now, all class definitions go in headers,
154    # one class per header, with non-inline method definitions going
155    # into corresponding source files.
156    set DEFAULT_CLASS_SPECS {}
157
158    # The default value for the "count" field of class_specs.
159    set DEFAULT_CLASS_COUNT 1
160
161    # The default number of members in each class.
162    set DEFAULT_CLASS_NR_MEMBERS 0
163
164    # The default number of static members in each class.
165    set DEFAULT_CLASS_NR_STATIC_MEMBERS 0
166
167    # The default number of methods in each class.
168    set DEFAULT_CLASS_NR_METHODS 0
169
170    # The default number of inline methods in each class.
171    set DEFAULT_CLASS_NR_INLINE_METHODS 0
172
173    # The default number of static methods in each class.
174    set DEFAULT_CLASS_NR_STATIC_METHODS 0
175
176    # The default number of static inline methods in each class.
177    set DEFAULT_CLASS_NR_STATIC_INLINE_METHODS 0
178
179    set header_suffixes(c) "h"
180    set header_suffixes(c++) "h"
181    set source_suffixes(c) "c"
182    set source_suffixes(c++) "cc"
183
184    # Generate .worker files that control building all the "pieces" of the
185    # testcase.  This doesn't include "main" or any test-specific stuff.
186    # This mostly consists of the "bulk" (aka "crap" :-)) of the testcase to
187    # give gdb something meaty to chew on.
188    # The result is 0 for success, -1 for failure.
189    #
190    # Benchmarks generated by some of the tests are big.  I mean really big.
191    # And it's a pain to build one piece at a time, we need a parallel build.
192    # To achieve this, given the framework we're working with, we need to
193    # generate arguments to pass to a parallel make.  This is done by
194    # generating several files and then passing the file names to the parallel
195    # make.  All of the needed info is contained in the file name, so we could
196    # do this differently, but this is pretty simple and flexible.
197
198    proc gen_worker_files { test_description_exp } {
199	global objdir PERF_TEST_COMPILE_PARALLELISM
200
201	if { [file tail $test_description_exp] != $test_description_exp } {
202	    error "test description file contains directory name"
203	}
204
205	set program_name [file rootname $test_description_exp]
206	set workers_dir "$objdir/gdb.perf/workers/$program_name"
207	file mkdir $workers_dir
208
209	set nr_workers $PERF_TEST_COMPILE_PARALLELISM
210	verbose -log "gen_worker_files: $test_description_exp $nr_workers workers"
211
212	for { set i 0 } { $i < $nr_workers } { incr i } {
213	    set file_name "${workers_dir}/${program_name}-${i}.worker"
214	    verbose -log "gen_worker_files: Generating $file_name"
215	    set f [open $file_name "w"]
216	    puts $f "# DO NOT EDIT, machine generated file."
217	    puts $f "# See perftest.exp:GenPerfTest::gen_worker_files."
218	    close $f
219	}
220
221	return 0
222    }
223
224    # Load a perftest description.
225    # Test descriptions are used to build the input files (binary + shlibs)
226    # of one or more performance tests.
227
228    proc load_test_description { basename } {
229	global srcdir
230
231	if { [file tail $basename] != $basename } {
232	    error "test description file contains directory name"
233	}
234
235	verbose -log "load_file $srcdir/gdb.perf/$basename"
236	if { [load_file $srcdir/gdb.perf/$basename] == 0 } {
237	    error "Unable to load test description $basename"
238	}
239    }
240
241    # Create a testcase object for test NAME.
242    # The caller must call this as:
243    # array set my_test [GenPerfTest::init_testcase $name]
244
245    proc init_testcase { name } {
246	set testcase(name) $name
247	set testcase(language) $GenPerfTest::DEFAULT_LANGUAGE
248	set testcase(run_names) [list $name]
249	set testcase(binary_extra_sources) $GenPerfTest::DEFAULT_BINARY_EXTRA_SOURCES
250	set testcase(binary_extra_headers) $GenPerfTest::DEFAULT_BINARY_EXTRA_HEADERS
251	set testcase(gen_shlib_extra_sources) $GenPerfTest::DEFAULT_GEN_SHLIB_EXTRA_SOURCES
252	set testcase(gen_shlib_extra_headers) $GenPerfTest::DEFAULT_GEN_SHLIB_EXTRA_HEADERS
253	set testcase(tail_shlib_sources) $GenPerfTest::DEFAULT_TAIL_SHLIB_SOURCES
254	set testcase(tail_shlib_headers) $GenPerfTest::DEFAULT_TAIL_SHLIB_HEADERS
255	set testcase(nr_gen_shlibs) $GenPerfTest::DEFAULT_NR_GEN_SHLIBS
256	set testcase(nr_compunits) $GenPerfTest::DEFAULT_NR_COMPUNITS
257
258	set testcase(nr_extern_globals) $GenPerfTest::DEFAULT_NR_EXTERN_GLOBALS
259	set testcase(nr_static_globals) $GenPerfTest::DEFAULT_NR_STATIC_GLOBALS
260	set testcase(nr_extern_functions) $GenPerfTest::DEFAULT_NR_EXTERN_FUNCTIONS
261	set testcase(nr_static_functions) $GenPerfTest::DEFAULT_NR_STATIC_FUNCTIONS
262
263	set testcase(class_specs) $GenPerfTest::DEFAULT_CLASS_SPECS
264
265	# The location of this file drives the location of all other files.
266	# The choice is derived from standard_output_file.  We don't use it
267	# because of the parallel build support, we want each worker's log/sum
268	# files to go in different directories, but we don't want their output
269	# to go in different directories.
270	# N.B. The value here must be kept in sync with Makefile.in.
271	global objdir
272	set name_no_spaces [_convert_spaces $name]
273	set testcase(binfile) "$objdir/gdb.perf/outputs/$name_no_spaces/$name_no_spaces"
274
275	return [array get testcase]
276    }
277
278    proc _verify_parameter_lengths { self_var } {
279	upvar 1 $self_var self
280	set params {
281	    binary_extra_sources binary_extra_headers
282	    gen_shlib_extra_sources gen_shlib_extra_headers
283	    tail_shlib_sources tail_shlib_headers
284	    nr_gen_shlibs nr_compunits
285	    nr_extern_globals nr_static_globals
286	    nr_extern_functions nr_static_functions
287	    class_specs
288	}
289	set nr_runs [llength $self(run_names)]
290	foreach p $params {
291	    set n [llength $self($p)]
292	    if { $n > 1 } {
293		if { $n != $nr_runs } {
294		    error "Bad number of values for parameter $p"
295		}
296		set values $self($p)
297		for { set i 0 } { $i < $n - 1 } { incr i } {
298		    if { [lindex $values $i] > [lindex $values [expr $i + 1]] } {
299			error "Values of parameter $p are not increasing"
300		    }
301		}
302	    }
303	}
304    }
305
306    # Verify the class_specs parameter.
307
308    proc _verify_class_specs { self_var } {
309	upvar 1 $self_var self
310	set nr_runs [llength $self(run_names)]
311	for { set run_nr 0 } { $run_nr < $nr_runs } { incr run_nr } {
312	    set class_specs [_get_param $self(class_specs) $run_nr]
313	    foreach { spec } $class_specs {
314		if { [llength $spec] % 2 != 0 } {
315		    error "Uneven number of values in class spec: $spec"
316		}
317		foreach { key value } $spec {
318		    switch -exact -- $key {
319			name { }
320			count -
321			nr_members - nr_static_members -
322			nr_methods - nr_static_methods -
323			nr_inline_methods - nr_static_inline_methods
324			{
325			    if ![string is integer $value] {
326				error "Non-integer value $value for key $key in class_specs: $class_specs"
327			    }
328			}
329			default {
330			    error "Unrecognized key $key in class_specs: $class_specs"
331			}
332		    }
333		}
334	    }
335	}
336    }
337
338    # Verify the testcase is valid (as best we can, this isn't exhaustive).
339
340    proc _verify_testcase { self_var } {
341	upvar 1 $self_var self
342	_verify_parameter_lengths self
343	_verify_class_specs self
344
345	# Each test must supply its own main().  We don't check for main here,
346	# but we do verify the test supplied something.
347	if { [llength $self(binary_extra_sources)] == 0 } {
348	    error "Missing value for binary_extra_sources"
349	}
350    }
351
352    # Return the value of parameter PARAM for run RUN_NR.
353
354    proc _get_param { param run_nr } {
355	if { [llength $param] == 1 } {
356	    # Since PARAM may be a list of lists we need to use lindex.  This
357	    # also works for scalars (scalars are degenerate lists).
358	    return [lindex $param 0]
359	}
360	return [lindex $param $run_nr]
361    }
362
363    # Return non-zero if all files (binaries + shlibs) can be compiled from
364    # one set of object files.  This is a simple optimization to speed up
365    # test build times.  This happens if the only variation among runs is
366    # nr_gen_shlibs or nr_compunits.
367
368    proc _static_object_files_p { self_var } {
369	upvar 1 $self_var self
370	# These values are either scalars, or can vary across runs but don't
371	# affect whether we can share the generated object objects between
372	# runs.
373	set static_object_file_params {
374	    name language run_names nr_gen_shlibs nr_compunits
375	    binary_extra_sources gen_shlib_extra_sources tail_shlib_sources
376	}
377	foreach name [array names self] {
378	    if { [lsearch $static_object_file_params $name] < 0 } {
379		# name is not in static_object_file_params.
380		if { [llength $self($name)] > 1 } {
381		    # The user could provide a list that is all the same value,
382		    # so check for that.
383		    set first_value [lindex $self($name) 0]
384		    foreach elm [lrange $self($name) 1 end] {
385			if { $elm != $first_value } {
386			    return 0
387			}
388		    }
389		}
390	    }
391	}
392	return 1
393    }
394
395    # Return non-zero if classes are enabled.
396
397    proc _classes_enabled_p { self_var run_nr } {
398	upvar 1 $self_var self
399	set class_specs [_get_param $self(class_specs) $run_nr]
400	return [expr [llength $class_specs] > 0]
401    }
402
403    # Spaces in file names are a pain, remove them.
404    # They appear if the user puts spaces in the test name or run name.
405
406    proc _convert_spaces { file_name } {
407	return [regsub -all " " $file_name "-"]
408    }
409
410    # Return the compilation flags for the test.
411
412    proc _compile_options { self_var } {
413	upvar 1 $self_var self
414	set result {debug}
415	switch $self(language) {
416	    c++ {
417		lappend result "c++"
418	    }
419	}
420	return $result
421    }
422
423    # Return the path to put source/object files in for run number RUN_NR.
424
425    proc _make_object_dir_name { self_var static run_nr } {
426	upvar 1 $self_var self
427	# Note: The output directory already includes the name of the test
428	# description file.
429	set bindir [file dirname $self(binfile)]
430	# Put the pieces in a subdirectory, there are a lot of them.
431	if $static {
432	    return "$bindir/pieces"
433	} else {
434	    set run_name [_convert_spaces [lindex $self(run_names) $run_nr]]
435	    return "$bindir/pieces/$run_name"
436	}
437    }
438
439    # RUN_NR is ignored if STATIC is non-zero.
440    # SO_NR is the shlib number or "" for the binary.
441    # CU_NR is either the compilation unit number or "main".
442
443    proc _make_header_basename { self_var static run_nr so_nr cu_nr } {
444	upvar 1 $self_var self
445	set header_suffix $GenPerfTest::header_suffixes($self(language))
446	if { !$static } {
447	    set run_name [_get_param $self(run_names) $run_nr]
448	    if { "$so_nr" != "" } {
449		set header_name "${run_name}-lib${so_nr}-cu${cu_nr}.$header_suffix"
450	    } else {
451		set header_name "${run_name}-cu${cu_nr}.$header_suffix"
452	    }
453	} else {
454	    if { "$so_nr" != "" } {
455		set header_name "lib${so_nr}-cu${cu_nr}.$header_suffix"
456	    } else {
457		set header_name "cu${cu_nr}.$header_suffix"
458	    }
459	}
460	return "[_convert_spaces $header_name]"
461    }
462
463    # RUN_NR is ignored if STATIC is non-zero.
464    # SO_NR is the shlib number or "" for the binary.
465    # CU_NR is either the compilation unit number or "main".
466
467    proc _make_header_name { self_var static run_nr so_nr cu_nr } {
468	upvar 1 $self_var self
469	set header_name [_make_header_basename self $static $run_nr $so_nr $cu_nr]
470	return "[_make_object_dir_name self $static $run_nr]/$header_name"
471    }
472
473    # RUN_NR is ignored if STATIC is non-zero.
474    # SO_NR is the shlib number or "" for the binary.
475    # CU_NR is either the compilation unit number or "main".
476
477    proc _make_source_basename { self_var static run_nr so_nr cu_nr } {
478	upvar 1 $self_var self
479	set source_suffix $GenPerfTest::source_suffixes($self(language))
480	if { !$static } {
481	    set run_name [_get_param $self(run_names) $run_nr]
482	    if { "$so_nr" != "" } {
483		set source_name "${run_name}-lib${so_nr}-cu${cu_nr}.$source_suffix"
484	    } else {
485		set source_name "${run_name}-cu${cu_nr}.$source_suffix"
486	    }
487	} else {
488	    if { "$so_nr" != "" } {
489		set source_name "lib${so_nr}-cu${cu_nr}.$source_suffix"
490	    } else {
491		set source_name "cu${cu_nr}.$source_suffix"
492	    }
493	}
494	return "[_convert_spaces $source_name]"
495    }
496
497    # RUN_NR is ignored if STATIC is non-zero.
498    # SO_NR is the shlib number or "" for the binary.
499    # CU_NR is either the compilation unit number or "main".
500
501    proc _make_source_name { self_var static run_nr so_nr cu_nr } {
502	upvar 1 $self_var self
503	set source_name [_make_source_basename self $static $run_nr $so_nr $cu_nr]
504	return "[_make_object_dir_name self $static $run_nr]/$source_name"
505    }
506
507    # Generated object files get put in the same directory as their source.
508    # WARNING: This means that we can't do parallel compiles from the same
509    # source file, they have to have different names.
510
511    proc _make_binary_object_name { self_var static run_nr cu_nr } {
512	upvar 1 $self_var self
513	set source_name [_make_source_name self $static $run_nr "" $cu_nr]
514	return [file rootname $source_name].o
515    }
516
517    # Return the list of source/object files for the binary.
518    # This is the source files specified in test param binary_extra_sources as
519    # well as the names of all the object file "pieces".
520    # STATIC is the value of _static_object_files_p for the test.
521
522    proc _make_binary_input_file_names { self_var static run_nr } {
523	upvar 1 $self_var self
524	global srcdir subdir
525	set nr_compunits [_get_param $self(nr_compunits) $run_nr]
526	set result {}
527	foreach source [_get_param $self(binary_extra_sources) $run_nr] {
528	    lappend result "$srcdir/$subdir/$source"
529	}
530	for { set cu_nr 0 } { $cu_nr < $nr_compunits } { incr cu_nr } {
531	    lappend result [_make_binary_object_name self $static $run_nr $cu_nr]
532	}
533	return $result
534    }
535
536    proc _make_binary_name { self_var run_nr } {
537	upvar 1 $self_var self
538	set run_name [_get_param $self(run_names) $run_nr]
539	set exe_name "$self(binfile)-[_convert_spaces ${run_name}]"
540	return $exe_name
541    }
542
543    # SO_NAME is either a shlib number or "tail".
544
545    proc _make_shlib_name { self_var static run_nr so_name } {
546	upvar 1 $self_var self
547	if { !$static } {
548	    set run_name [_get_param $self(run_names) $run_nr]
549	    set lib_name "$self(name)-${run_name}-lib${so_name}.so"
550	} else {
551	    set lib_name "$self(name)-lib${so_name}.so"
552	}
553	set output_dir [file dirname $self(binfile)]
554	return "[_make_object_dir_name self $static $run_nr]/[_convert_spaces $lib_name]"
555    }
556
557    proc _create_file { self_var path } {
558	upvar 1 $self_var self
559	verbose -log "Creating file: $path"
560	set f [open $path "w"]
561	return $f
562    }
563
564    proc _write_intro { self_var f } {
565	upvar 1 $self_var self
566	puts $f "// DO NOT EDIT, machine generated file."
567	puts $f "// See perftest.exp:GenPerfTest."
568    }
569
570    proc _write_includes { self_var f includes } {
571	upvar 1 $self_var self
572	if { [llength $includes] > 0 } {
573	    puts $f ""
574	}
575	foreach i $includes {
576	    switch -glob -- $i {
577		"<*>" {
578		    puts $f "#include $i"
579		}
580		default {
581		    puts $f "#include \"$i\""
582		}
583	    }
584	}
585    }
586
587    proc _make_header_macro { name c } {
588	return [string toupper "${name}_${c}"]
589    }
590
591    proc _write_static_globals { self_var f run_nr } {
592	upvar 1 $self_var self
593	puts $f ""
594	set nr_static_globals [_get_param $self(nr_static_globals) $run_nr]
595	# Rather than parameterize the number of const/non-const globals,
596	# and their types, we keep it simple for now.	Even the number of
597	# bss/non-bss globals may be useful; later, if warranted.
598	for { set i 0 } { $i < $nr_static_globals } { incr i } {
599	    if { $i % 2 == 0 } {
600		set const "const "
601	    } else {
602		set const ""
603	    }
604	    puts $f "static ${const}int static_global_$i = $i;"
605	}
606    }
607
608    # ID is "" for the binary, and a unique symbol prefix for each SO.
609
610    proc _write_extern_globals { self_var f run_nr id cu_nr } {
611	upvar 1 $self_var self
612	puts $f ""
613	set nr_extern_globals [_get_param $self(nr_extern_globals) $run_nr]
614	# Rather than parameterize the number of const/non-const globals,
615	# and their types, we keep it simple for now.	Even the number of
616	# bss/non-bss globals may be useful; later, if warranted.
617	for { set i 0 } { $i < $nr_extern_globals } { incr i } {
618	    if { $i % 2 == 0 } {
619		set const "const "
620	    } else {
621		set const ""
622	    }
623	    puts $f "${const}int ${id}global_${cu_nr}_$i = $cu_nr * 1000 + $i;"
624	}
625    }
626
627    proc _write_static_functions { self_var f run_nr } {
628	upvar 1 $self_var self
629	set nr_static_functions [_get_param $self(nr_static_functions) $run_nr]
630	for { set i 0 } { $i < $nr_static_functions } { incr i } {
631	    puts $f ""
632	    puts $f "static void"
633	    puts $f "static_function_$i (void)"
634	    puts $f "{"
635	    puts $f "}"
636	}
637    }
638
639    # ID is "" for the binary, and a unique symbol prefix for each SO.
640
641    proc _write_extern_functions { self_var f run_nr id cu_nr } {
642	upvar 1 $self_var self
643	set nr_extern_functions [_get_param $self(nr_extern_functions) $run_nr]
644	for { set i 0 } { $i < $nr_extern_functions } { incr i } {
645	    puts $f ""
646	    puts $f "void"
647	    puts $f "${id}function_${cu_nr}_$i (void)"
648	    puts $f "{"
649	    puts $f "}"
650	}
651    }
652
653    proc _get_class_spec { spec name } {
654	foreach { key value } $spec {
655	    if { $key == $name } {
656		return $value
657	    }
658	}
659	switch $name {
660	    count {
661		return $GenPerfTest::DEFAULT_CLASS_COUNT
662	    }
663	    nr_members {
664		return $GenPerfTest::DEFAULT_CLASS_NR_MEMBERS
665	    }
666	    nr_static_members {
667		return $GenPerfTest::DEFAULT_CLASS_NR_STATIC_MEMBERS
668	    }
669	    nr_methods {
670		return $GenPerfTest::DEFAULT_CLASS_NR_METHODS
671	    }
672	    nr_inline_methods {
673		return $GenPerfTest::DEFAULT_CLASS_NR_INLINE_METHODS
674	    }
675	    nr_static_methods {
676		return $GenPerfTest::DEFAULT_CLASS_NR_STATIC_METHODS
677	    }
678	    nr_static_inline_methods {
679		return $GenPerfTest::DEFAULT_CLASS_NR_STATIC_INLINE_METHODS
680	    }
681	    default {
682		error "required class-spec not present: $name"
683	    }
684	}
685    }
686
687    # SO_NR is the shlib number or "" for the binary.
688    # CU_NR is either the compilation unit number or "main".
689    # NAME is the "name" field from the class spec, which is
690    # { ns0 ns1 ... nsN class_name }.
691    # C is the iteration number, from the "count" field from the class spec.
692
693    proc _make_class_name { so_nr cu_nr name c } {
694	set class_name [lindex $name [expr [llength $name] - 1]]
695	if { "$so_nr" != "" } {
696	    set prefix "shlib${so_nr}_"
697	} else {
698	    set prefix ""
699	}
700	return "${prefix}cu_${cu_nr}_${class_name}_${c}"
701    }
702
703    proc _make_namespace_name { name } {
704	if { "$name" == "anonymous" } {
705	    return ""
706	}
707	return $name
708    }
709
710    proc _write_class_definitions { self_var f static run_nr so_nr cu_nr } {
711	upvar 1 $self_var self
712	set class_specs [_get_param $self(class_specs) $run_nr]
713	foreach spec $class_specs {
714	    set count [_get_class_spec $spec count]
715	    set name [_get_class_spec $spec name]
716	    set nr_members [_get_class_spec $spec nr_members]
717	    set nr_static_members [_get_class_spec $spec nr_static_members]
718	    set nr_methods [_get_class_spec $spec nr_methods]
719	    set nr_static_methods [_get_class_spec $spec nr_static_methods]
720	    set depth [expr [llength $name] - 1]
721	    for { set c 0 } { $c < $count } { incr c } {
722		puts $f ""
723		for { set i 0 } { $i < $depth } { incr i } {
724		    puts $f "namespace [_make_namespace_name [lindex $name $i]]"
725		    puts $f "\{"
726		    puts $f ""
727		}
728		set class_name [_make_class_name $so_nr $cu_nr $name $c]
729		puts $f "class $class_name"
730		puts $f "\{"
731		puts $f " public:"
732		for { set i 0 } { $i < $nr_members } { incr i } {
733		    puts $f "  int member_$i;"
734		}
735		for { set i 0 } { $i < $nr_static_members } { incr i } {
736		    # Rather than parameterize the number of const/non-const
737		    # members, and their types, we keep it simple for now.
738		    if { $i % 2 == 0 } {
739			puts $f "  static const int static_member_$i = $i;"
740		    } else {
741			puts $f "  static int static_member_$i;"
742		    }
743		}
744		for { set i 0 } { $i < $nr_methods } { incr i } {
745		    puts $f "  void method_$i (void);"
746		}
747		for { set i 0 } { $i < $nr_static_methods } { incr i } {
748		    puts $f "  static void static_method_$i (void);"
749		}
750		_write_inline_methods self $f $so_nr $cu_nr $spec $c
751		_write_static_inline_methods self $f $so_nr $cu_nr $spec $c
752		puts $f "\};"
753		for { set i [expr $depth - 1] } { $i >= 0 } { incr i -1 } {
754		    puts $f ""
755		    puts $f "\} // [lindex $name $i]"
756		}
757	    }
758	}
759    }
760
761    proc _write_inline_methods { self_var f so_nr cu_nr spec c } {
762	upvar 1 $self_var self
763	set name [_get_class_spec $spec name]
764	set nr_inline_methods [_get_class_spec $spec nr_inline_methods]
765	for { set i 0 } { $i < $nr_inline_methods } { incr i } {
766	    puts $f "  void inline_method_$i (void) { }"
767	}
768    }
769
770    proc _write_static_inline_methods { self_var f so_nr cu_nr spec c } {
771	upvar 1 $self_var self
772	set name [_get_class_spec $spec name]
773	set nr_static_inline_methods [_get_class_spec $spec nr_static_inline_methods]
774	for { set i 0 } { $i < $nr_static_inline_methods } { incr i } {
775	    puts $f "  static void static_inline_method_$i (void) { }"
776	}
777    }
778
779    proc _write_class_implementations { self_var f static run_nr so_nr cu_nr } {
780	upvar 1 $self_var self
781	set class_specs [_get_param $self(class_specs) $run_nr]
782	foreach spec $class_specs {
783	    set count [_get_class_spec $spec count]
784	    set name [_get_class_spec $spec name]
785	    set depth [expr [llength $name] - 1]
786	    for { set c 0 } { $c < $count } { incr c } {
787		for { set i 0 } { $i < $depth } { incr i } {
788		    puts $f ""
789		    puts $f "namespace [_make_namespace_name [lindex $name $i]]"
790		    puts $f "\{"
791		}
792		_write_static_members self $f $so_nr $cu_nr $spec $c
793		_write_methods self $f $so_nr $cu_nr $spec $c
794		_write_static_methods self $f $so_nr $cu_nr $spec $c
795		for { set i [expr $depth - 1] } { $i >= 0 } { incr i -1 } {
796		    puts $f ""
797		    puts $f "\} // [lindex $name $i]"
798		}
799	    }
800	}
801    }
802
803    proc _write_static_members { self_var f so_nr cu_nr spec c } {
804	upvar 1 $self_var self
805	set name [_get_class_spec $spec name]
806	set nr_static_members [_get_class_spec $spec nr_static_members]
807	set class_name [_make_class_name $so_nr $cu_nr $name $c]
808	puts $f ""
809	# Rather than parameterize the number of const/non-const
810	# members, and their types, we keep it simple for now.
811	for { set i 0 } { $i < $nr_static_members } { incr i } {
812	    if { $i % 2 == 0 } {
813		# Static const members are initialized inline.
814	    } else {
815		puts $f "int ${class_name}::static_member_$i = $i;"
816	    }
817	}
818    }
819
820    proc _write_methods { self_var f so_nr cu_nr spec c } {
821	upvar 1 $self_var self
822	set name [_get_class_spec $spec name]
823	set nr_methods [_get_class_spec $spec nr_methods]
824	set class_name [_make_class_name $so_nr $cu_nr $name $c]
825	for { set i 0 } { $i < $nr_methods } { incr i } {
826	    puts $f ""
827	    puts $f "void"
828	    puts $f "${class_name}::method_$i (void)"
829	    puts $f "{"
830	    puts $f "}"
831	}
832    }
833
834    proc _write_static_methods { self_var f so_nr cu_nr spec c } {
835	upvar 1 $self_var self
836	set name [_get_class_spec $spec name]
837	set nr_static_methods [_get_class_spec $spec nr_static_methods]
838	set class_name [_make_class_name $so_nr $cu_nr $name $c]
839	for { set i 0 } { $i < $nr_static_methods } { incr i } {
840	    puts $f ""
841	    puts $f "void"
842	    puts $f "${class_name}::static_method_$i (void)"
843	    puts $f "{"
844	    puts $f "}"
845	}
846    }
847
848    proc _gen_compunit_header { self_var static run_nr so_nr cu_nr } {
849	upvar 1 $self_var self
850	set header_file [_make_header_name self $static $run_nr $so_nr $cu_nr]
851	set f [_create_file self $header_file]
852	_write_intro self $f
853	set header_macro [_make_header_macro "HEADER_CU" $cu_nr]
854	puts $f ""
855	puts $f "#ifndef $header_macro"
856	puts $f "#define $header_macro"
857	if [_classes_enabled_p self $run_nr] {
858	    _write_class_definitions self $f $static $run_nr $so_nr $cu_nr
859	}
860	puts $f ""
861	puts $f "#endif // $header_macro"
862	close $f
863	return $header_file
864    }
865
866    proc _gen_binary_compunit_source { self_var static run_nr cu_nr } {
867	upvar 1 $self_var self
868	set source_file [_make_source_name self $static $run_nr "" $cu_nr]
869	set f [_create_file self $source_file]
870	_write_intro self $f
871	_write_includes self $f [_get_param $self(binary_extra_headers) $run_nr]
872	set header_file [_make_header_basename self $static $run_nr "" $cu_nr]
873	puts $f "#include \"$header_file\""
874	_write_static_globals self $f $run_nr
875	_write_extern_globals self $f $run_nr "" $cu_nr
876	_write_static_functions self $f $run_nr
877	_write_extern_functions self $f $run_nr "" $cu_nr
878	if [_classes_enabled_p self $run_nr] {
879	    _write_class_implementations self $f $static $run_nr "" $cu_nr
880	}
881	close $f
882	return $source_file
883    }
884
885    # Generate the sources for the pieces of the binary.
886    # The result is a list of source file names and accompanying object file
887    # names.  The pieces are split across workers.
888    # E.g., with 10 workers the result for worker 0 is
889    # { { source0 header0 object0 } { source10 header10 object10 } ... }
890
891    proc _gen_binary_source { self_var worker_nr static run_nr } {
892	upvar 1 $self_var self
893	verbose -log "GenPerfTest::_gen_binary_source worker $worker_nr run $run_nr, started [timestamp -format %c]"
894	set nr_compunits [_get_param $self(nr_compunits) $run_nr]
895	global PERF_TEST_COMPILE_PARALLELISM
896	set nr_workers $PERF_TEST_COMPILE_PARALLELISM
897	set result {}
898	for { set cu_nr $worker_nr } { $cu_nr < $nr_compunits } { incr cu_nr $nr_workers } {
899	    set header_file [_gen_compunit_header self $static $run_nr "" $cu_nr]
900	    set source_file [_gen_binary_compunit_source self $static $run_nr $cu_nr]
901	    set object_file [_make_binary_object_name self $static $run_nr $cu_nr]
902	    lappend result [list $source_file $header_file $object_file]
903	}
904	verbose -log "GenPerfTest::_gen_binary_source worker $worker_nr run $run_nr, done [timestamp -format %c]"
905	return $result
906    }
907
908    proc _gen_shlib_compunit_source { self_var static run_nr so_nr cu_nr } {
909	upvar 1 $self_var self
910	set source_file [_make_source_name self $static $run_nr $so_nr $cu_nr]
911	set f [_create_file self $source_file]
912	_write_intro self $f
913	_write_includes self $f [_get_param $self(gen_shlib_extra_headers) $run_nr]
914	set header_file [_make_header_basename self $static $run_nr $so_nr $cu_nr]
915	puts $f "#include \"$header_file\""
916	_write_static_globals self $f $run_nr
917	_write_extern_globals self $f $run_nr "shlib${so_nr}_" $cu_nr
918	_write_static_functions self $f $run_nr
919	_write_extern_functions self $f $run_nr "shlib${so_nr}_" $cu_nr
920	if [_classes_enabled_p self $run_nr] {
921	    _write_class_implementations self $f $static $run_nr $so_nr $cu_nr
922	}
923	close $f
924	return $source_file
925    }
926
927    # CU_NAME is a name from gen_shlib_extra_sources or tail_shlib_sources.
928
929    proc _make_shlib_common_source_name { self_var static run_nr so_nr cu_name } {
930	upvar 1 $self_var self
931	if { !$static } {
932	    set run_name [_get_param $self(run_names) $run_nr]
933	    set source_name "${run_name}-lib${so_nr}-${cu_name}"
934	} else {
935	    set source_name "lib${so_nr}-${cu_name}"
936	}
937	return "[_make_object_dir_name self $static $run_nr]/[_convert_spaces $source_name]"
938    }
939
940    # N.B. gdb_compile_shlib doesn't support parallel builds of shlibs from
941    # common sources: the .o file path will be the same across all shlibs.
942    # gen_shlib_extra_sources may be common across all shlibs but they're each
943    # compiled with -DSHLIB=$SHLIB so we need different .o files for each
944    # shlib, and therefore we need different source files for each shlib.
945    # If this turns out to be too cumbersome we can augment gdb_compile_shlib.
946
947    proc _gen_shlib_common_source { self_var static run_nr so_nr source_name } {
948	upvar 1 $self_var self
949	global srcdir
950	set source_file [_make_shlib_common_source_name self $static $run_nr $so_nr $source_name]
951	file copy -force "$srcdir/gdb.perf/$source_name" ${source_file}
952	return $source_file
953    }
954
955    # Generate the sources for a shared library.
956    # The result is a list of source and header file names.
957    # E.g., { { source0 source1 ... common0 ... } { header0 header1 ... } }
958
959    proc _gen_shlib_source { self_var static run_nr so_nr } {
960	upvar 1 $self_var self
961	verbose -log "GenPerfTest::_gen_shlib_source run $run_nr so $so_nr, started [timestamp -format %c]"
962	set headers {}
963	set sources {}
964	set nr_compunits [_get_param $self(nr_compunits) $run_nr]
965	for { set cu_nr 0 } { $cu_nr < $nr_compunits } { incr cu_nr } {
966	    lappend headers [_gen_compunit_header self $static $run_nr $so_nr $cu_nr]
967	    lappend sources [_gen_shlib_compunit_source self $static $run_nr $so_nr $cu_nr]
968	}
969	foreach source_name [_get_param $self(gen_shlib_extra_sources) $run_nr] {
970	    lappend sources [_gen_shlib_common_source self $static $run_nr $so_nr $source_name]
971	}
972	verbose -log "GenPerfTest::_gen_shlib_source run $run_nr so $so_nr, done [timestamp -format %c]"
973	return [list $sources $headers]
974    }
975
976    # Write Tcl array ARRAY_NAME to F.
977
978    proc _write_tcl_array { self_var f array_name } {
979	upvar 1 $self_var self
980	if { "$array_name" != "$self_var" } {
981	    global $array_name
982	}
983	puts $f "== $array_name =="
984	foreach { name value } [array get $array_name] {
985	    puts $f "$name: $value"
986	}
987    }
988
989    # Write global Tcl state used for compilation to F.
990    # If anything changes we want to recompile.
991
992    proc _write_tcl_state { self_var f dest } {
993	upvar 1 $self_var self
994
995	# TODO(dje): gdb_default_target_compile references a lot of global
996	# state.  Can we capture it all?  For now these are the important ones.
997
998	set vars { CC_FOR_TARGET CXX_FOR_TARGET CFLAGS_FOR_TARGET }
999	foreach v $vars {
1000	    global $v
1001	    if [info exists $v] {
1002		eval set value $$v
1003		puts $f "$v: $value"
1004	    }
1005	}
1006
1007	puts $f ""
1008	_write_tcl_array self $f target_info
1009	puts $f ""
1010	_write_tcl_array self $f board_info
1011    }
1012
1013    # Write all sideband non-file inputs, as well as OPTIONS to INPUTS_FILE.
1014    # If anything changes we want to recompile.
1015
1016    proc _write_inputs_file { self_var dest inputs_file options } {
1017	upvar 1 $self_var self
1018	global env
1019	set f [open $inputs_file "w"]
1020	_write_tcl_array self $f self
1021	puts $f ""
1022	puts $f "options: $options"
1023	puts $f "PATH: [getenv PATH]"
1024	puts $f ""
1025	_write_tcl_state self $f $dest
1026	close $f
1027    }
1028
1029    # Generate the sha1sum of all the inputs.
1030    # The result is a list of { error_code text }.
1031    # Upon success error_code is zero and text is the sha1sum.
1032    # Otherwise, error_code is non_zero and text is the error message.
1033
1034    proc _gen_sha1sum_for_inputs { source_files header_files inputs } {
1035	global srcdir subdir CAT_PROGRAM SHA1SUM_PROGRAM
1036	set header_paths ""
1037	foreach f $header_files {
1038	    switch -glob -- $f {
1039		"<*>" {
1040		    # skip
1041		}
1042		"*gdb.perf/outputs/*" {
1043		    # in build tree
1044		    append header_paths " $f"
1045		}
1046		default {
1047		    append header_paths " $srcdir/$subdir/$f"
1048		}
1049	    }
1050	}
1051	verbose -log "_gen_sha1sum_for_inputs: summing $source_files $header_paths $inputs"
1052	set catch_result [catch "exec $CAT_PROGRAM $source_files $header_paths $inputs | $SHA1SUM_PROGRAM" output]
1053        return [list $catch_result $output]
1054    }
1055
1056    # Return the contents of TEXT_FILE.
1057    # It is assumed TEXT_FILE exists and is readable.
1058    # This is used for reading files containing sha1sums, the
1059    # last newline is removed.
1060
1061    proc _read_file { text_file } {
1062	set f [open $text_file "r"]
1063	set result [read -nonewline $f]
1064	close $f
1065	return $result
1066    }
1067
1068    # Write TEXT to TEXT_FILE.
1069    # It is assumed TEXT_FILE can be opened/created and written to.
1070
1071    proc _write_file { text_file text } {
1072	set f [open $text_file "w"]
1073	puts $f $text
1074	close $f
1075    }
1076
1077    # Wrapper on gdb_compile* that computes sha1sums of inputs to decide
1078    # whether the compile is needed.
1079    # The result is the result of gdb_compile*: "" == success, otherwise
1080    # a compilation error occurred and the output is an error message.
1081    # This doesn't take all inputs into account, just the useful ones.
1082    # As an extension (or simplification) on gdb_compile*, if TYPE is
1083    # shlib then call gdb_compile_shlib, otherwise call gdb_compile.
1084    # Other possibilities *could* be handled this way, e.g., pthreads.  TBD.
1085
1086    proc _perftest_compile { self_var source_files header_files dest type options } {
1087	upvar 1 $self_var self
1088	verbose -log "_perftest_compile $source_files $header_files $dest $type $options"
1089	# To keep things simple, we put all non-file inputs into a file and
1090	# then cat all input files through sha1sum.
1091	set sha1sum_file ${dest}.sha1sum
1092	set sha1new_file ${dest}.sha1new
1093	set inputs_file ${dest}.inputs
1094	global srcdir subdir
1095	set all_options $options
1096	lappend all_options "incdir=$srcdir/$subdir"
1097	_write_inputs_file self $dest $inputs_file $all_options
1098	set sha1sum [_gen_sha1sum_for_inputs $source_files $header_files $inputs_file]
1099	if { [lindex $sha1sum 0] != 0 } {
1100	    return "sha1sum generation error: [lindex $sha1sum 1]"
1101	}
1102	set sha1sum [lindex $sha1sum 1]
1103	if ![file exists $dest] {
1104	    file delete $sha1sum_file
1105	}
1106	if [file exists $sha1sum_file] {
1107	    set last_sha1sum [_read_file $sha1sum_file]
1108	    verbose -log "last: $last_sha1sum, new: $sha1sum"
1109	    if { $sha1sum == $last_sha1sum } {
1110		verbose -log "using existing build for $dest"
1111		return ""
1112	    }
1113	}
1114	# No such luck, we need to compile.
1115	file delete $sha1sum_file
1116	if { $type == "shlib" } {
1117	    set result [gdb_compile_shlib $source_files $dest $all_options]
1118	} else {
1119	    set result [gdb_compile $source_files $dest $type $all_options]
1120	}
1121	if { $result == "" } {
1122	    _write_file $sha1sum_file $sha1sum
1123	    verbose -log "wrote sha1sum: $sha1sum"
1124	}
1125	return $result
1126    }
1127
1128    proc _compile_binary_pieces { self_var worker_nr static run_nr } {
1129	upvar 1 $self_var self
1130	set compile_options [_compile_options self]
1131	set nr_compunits [_get_param $self(nr_compunits) $run_nr]
1132	set extra_headers [_get_param $self(binary_extra_headers) $run_nr]
1133	global PERF_TEST_COMPILE_PARALLELISM
1134	set nr_workers $PERF_TEST_COMPILE_PARALLELISM
1135	# Generate the source first so we can more easily measure how long that
1136	# takes.  [It doesn't take hardly any time at all, relative to the time
1137	# it takes to compile it, but this will provide numbers to show that.]
1138	set todo_list [_gen_binary_source self $worker_nr $static $run_nr]
1139	verbose -log "GenPerfTest::_compile_binary_pieces worker $worker_nr run $run_nr, started [timestamp -format %c]"
1140	foreach elm $todo_list {
1141	    set source_file [lindex $elm 0]
1142	    set header_file [lindex $elm 1]
1143	    set object_file [lindex $elm 2]
1144	    set all_header_files $extra_headers
1145	    lappend all_header_files $header_file
1146	    set compile_result [_perftest_compile self $source_file $all_header_files $object_file object $compile_options]
1147	    if { $compile_result != "" } {
1148		verbose -log "GenPerfTest::_compile_binary_pieces worker $worker_nr run $run_nr, failed [timestamp -format %c]"
1149		verbose -log $compile_result
1150		return -1
1151	    }
1152	}
1153	verbose -log "GenPerfTest::_compile_binary_pieces worker $worker_nr run $run_nr, done [timestamp -format %c]"
1154	return 0
1155    }
1156
1157    # Helper function to compile the pieces of a shlib.
1158    # Note: gdb_compile_shlib{,_pthreads} don't support first building object
1159    # files and then building the shlib.  Therefore our hands are tied, and we
1160    # just build the shlib in one step.  This is less of a parallelization
1161    # problem if there are multiple shlibs: Each worker can build a different
1162    # shlib.  If this proves to be a problem in practice we can enhance
1163    # gdb_compile_shlib* then.
1164
1165    proc _compile_shlib { self_var static run_nr so_nr } {
1166	upvar 1 $self_var self
1167	set files [_gen_shlib_source self $static $run_nr $so_nr]
1168	set source_files [lindex $files 0]
1169	set header_files [lindex $files 1]
1170	set extra_headers [_get_param $self(gen_shlib_extra_headers) $run_nr]
1171	set shlib_file [_make_shlib_name self $static $run_nr $so_nr]
1172	set compile_options "[_compile_options self] additional_flags=-DSHLIB=$so_nr"
1173	set all_header_files $header_files
1174	append all_header_files $extra_headers
1175	set compile_result [_perftest_compile self $source_files $all_header_files $shlib_file shlib $compile_options]
1176	if { $compile_result != "" } {
1177	    verbose -log "_compile_shlib failed: $compile_result"
1178	    return -1
1179	}
1180	return 0
1181    }
1182
1183    proc _gen_tail_shlib_source { self_var static run_nr } {
1184	upvar 1 $self_var self
1185	verbose -log "GenPerfTest::_gen_tail_shlib_source run $run_nr"
1186	set source_files [_get_param $self(tail_shlib_sources) $run_nr]
1187	if { [llength $source_files] == 0 } {
1188	    return ""
1189	}
1190	set result ""
1191	foreach source_name $source_files {
1192	    lappend result [_gen_shlib_common_source self $static $run_nr tail $source_name]
1193	}
1194	return $result
1195    }
1196
1197    proc _make_tail_shlib_name { self_var static run_nr } {
1198	upvar 1 $self_var self
1199	set source_files [_get_param $self(tail_shlib_sources) $run_nr]
1200	if { [llength $source_files] == 0 } {
1201	    return ""
1202	}
1203	return [_make_shlib_name self $static $run_nr "tail"]
1204    }
1205
1206    # Helper function to compile the tail shlib, if it's specified.
1207
1208    proc _compile_tail_shlib { self_var static run_nr } {
1209	upvar 1 $self_var self
1210	set source_files [_gen_tail_shlib_source self $static $run_nr]
1211	if { [llength $source_files] == 0 } {
1212	    return 0
1213	}
1214	set header_files [_get_param $self(tail_shlib_headers) $run_nr]
1215	set shlib_file [_make_tail_shlib_name self $static $run_nr]
1216	set compile_options [_compile_options self]
1217	set compile_result [_perftest_compile self $source_files $header_files $shlib_file shlib $compile_options]
1218	if { $compile_result != "" } {
1219	    verbose -log "_compile_tail_shlib failed: $compile_result"
1220	    return -1
1221	}
1222	verbose -log "_compile_tail_shlib failed: succeeded"
1223	return 0
1224    }
1225
1226    # Compile the pieces of the binary and possible shlibs for the test.
1227    # The result is 0 for success, -1 for failure.
1228
1229    proc _compile_pieces { self_var worker_nr } {
1230	upvar 1 $self_var self
1231	global PERF_TEST_COMPILE_PARALLELISM
1232	set nr_workers $PERF_TEST_COMPILE_PARALLELISM
1233	set nr_runs [llength $self(run_names)]
1234	set static [_static_object_files_p self]
1235	verbose -log "_compile_pieces: static flag: $static"
1236	file mkdir "[file dirname $self(binfile)]/pieces"
1237	if $static {
1238	    # All the generated pieces look the same (run over run) so just
1239	    # build all the shlibs of the last run (which is the largest).
1240	    set last_run [expr $nr_runs - 1]
1241	    set nr_gen_shlibs [_get_param $self(nr_gen_shlibs) $last_run]
1242	    set object_dir [_make_object_dir_name self $static ignored]
1243	    file mkdir $object_dir
1244	    for { set so_nr $worker_nr } { $so_nr < $nr_gen_shlibs } { incr so_nr $nr_workers } {
1245		if { [_compile_shlib self $static $last_run $so_nr] < 0 } {
1246		    return -1
1247		}
1248	    }
1249	    # We don't shard building of tail-shlib, so only build it once.
1250	    if { $worker_nr == 0 } {
1251		if { [_compile_tail_shlib self $static $last_run] < 0 } {
1252		    return -1
1253		}
1254	    }
1255	    if { [_compile_binary_pieces self $worker_nr $static $last_run] < 0 } {
1256		return -1
1257	    }
1258	} else {
1259	    for { set run_nr 0 } { $run_nr < $nr_runs } { incr run_nr } {
1260		set nr_gen_shlibs [_get_param $self(nr_gen_shlibs) $run_nr]
1261		set object_dir [_make_object_dir_name self $static $run_nr]
1262		file mkdir $object_dir
1263		for { set so_nr $worker_nr } { $so_nr < $nr_gen_shlibs } { incr so_nr $nr_workers } {
1264		    if { [_compile_shlib self $static $run_nr $so_nr] < 0 } {
1265			return -1
1266		    }
1267		}
1268		# We don't shard building of tail-shlib, so only build it once.
1269		if { $worker_nr == 0 } {
1270		    if { [_compile_tail_shlib self $static $run_nr] < 0 } {
1271			return -1
1272		    }
1273		}
1274		if { [_compile_binary_pieces self $worker_nr $static $run_nr] < 0 } {
1275		    return -1
1276		}
1277	    }
1278	}
1279	return 0
1280    }
1281
1282    # Main function invoked by each worker.
1283    # This builds all the things that are possible to build in parallel,
1284    # sharded up among all the workers.
1285
1286    proc compile_pieces { self_var worker_nr } {
1287	upvar 1 $self_var self
1288	verbose -log "GenPerfTest::compile_pieces worker $worker_nr, started [timestamp -format %c]"
1289	verbose -log "self: [array get self]"
1290	_verify_testcase self
1291	if { [_compile_pieces self $worker_nr] < 0 } {
1292	    verbose -log "GenPerfTest::compile_pieces worker $worker_nr, failed [timestamp -format %c]"
1293	    return -1
1294	}
1295	verbose -log "GenPerfTest::compile_pieces worker $worker_nr, done [timestamp -format %c]"
1296	return 0
1297    }
1298
1299    proc _make_shlib_options { self_var static run_nr } {
1300	upvar 1 $self_var self
1301	set nr_gen_shlibs [_get_param $self(nr_gen_shlibs) $run_nr]
1302	set result ""
1303	for { set i 0 } { $i < $nr_gen_shlibs } { incr i } {
1304	    lappend result "shlib=[_make_shlib_name self $static $run_nr $i]"
1305	}
1306	set tail_shlib_name [_make_tail_shlib_name self $static $run_nr]
1307	if { "$tail_shlib_name" != "" } {
1308	    lappend result "shlib=$tail_shlib_name"
1309	}
1310	return $result
1311    }
1312
1313    proc _compile_binary { self_var static run_nr } {
1314	upvar 1 $self_var self
1315	set input_files [_make_binary_input_file_names self $static $run_nr]
1316	set extra_headers [_get_param $self(binary_extra_headers) $run_nr]
1317	set binary_file [_make_binary_name self $run_nr]
1318	set compile_options [_compile_options self]
1319	set shlib_options [_make_shlib_options self $static $run_nr]
1320	if { [llength $shlib_options] > 0 } {
1321	    append compile_options " " $shlib_options
1322	}
1323	set compile_result [_perftest_compile self $input_files $extra_headers $binary_file executable $compile_options]
1324	if { $compile_result != "" } {
1325	    verbose -log "_compile_binary failed: $compile_result"
1326	    return -1
1327	}
1328	return 0
1329    }
1330
1331    # Helper function for compile.
1332    # The result is 0 for success, -1 for failure.
1333
1334    proc _compile { self_var } {
1335	upvar 1 $self_var self
1336	set nr_runs [llength $self(run_names)]
1337	set static [_static_object_files_p self]
1338	verbose -log "_compile: static flag: $static"
1339	for { set run_nr 0 } { $run_nr < $nr_runs } { incr run_nr } {
1340	    if { [_compile_binary self $static $run_nr] < 0 } {
1341		return -1
1342	    }
1343	}
1344	return 0
1345    }
1346
1347    # Main function to compile the test program.
1348    # It is assumed all the pieces of the binary (all the .o's, except those
1349    # from test-supplied sources) have already been built with compile_pieces.
1350    # There's no need to compile any shlibs here, as compile_pieces will have
1351    # already built them too.
1352    # The result is 0 for success, -1 for failure.
1353
1354    proc compile { self_var } {
1355	upvar 1 $self_var self
1356	verbose -log "GenPerfTest::compile, started [timestamp -format %c]"
1357	verbose -log "self: [array get self]"
1358	_verify_testcase self
1359	if { [_compile self] < 0 } {
1360	    verbose -log "GenPerfTest::compile, failed [timestamp -format %c]"
1361	    return -1
1362	}
1363	verbose -log "GenPerfTest::compile, done [timestamp -format %c]"
1364	return 0
1365    }
1366
1367    # Main function for running a test.
1368    # It is assumed that the test program has already been built.
1369
1370    proc run { builder_exp_file_name make_config_thunk_name py_file_name test_class_name } {
1371	verbose -log "GenPerfTest::run, started [timestamp -format %c]"
1372	verbose -log "GenPerfTest::run, $builder_exp_file_name $make_config_thunk_name $py_file_name $test_class_name"
1373
1374	set testprog [file rootname $builder_exp_file_name]
1375
1376	# This variable is required by perftest.exp.
1377	# This isn't the name of the test program, it's the name of the .py
1378	# test.  The harness assumes they are the same, which is not the case
1379	# here.
1380	global testfile
1381	set testfile [file rootname $py_file_name]
1382
1383	GenPerfTest::load_test_description $builder_exp_file_name
1384
1385	array set testcase [$make_config_thunk_name]
1386
1387	PerfTest::assemble {
1388	    # Compilation is handled elsewhere.
1389	    return 0
1390	} {
1391	    clean_restart
1392	    return 0
1393	} {
1394	    global gdb_prompt
1395	    gdb_test_multiple "python ${test_class_name}('$testprog:$testfile', [tcl_string_list_to_python_list $testcase(run_names)], '$testcase(binfile)').run()" "run test" {
1396		-re "Error while executing Python code.\[\r\n\]+$gdb_prompt $" {
1397		    return -1
1398		}
1399		-re "\[\r\n\]+$gdb_prompt $" {
1400		}
1401	    }
1402	    return 0
1403	}
1404	verbose -log "GenPerfTest::run, done [timestamp -format %c]"
1405	return 0
1406    }
1407
1408    # This function is invoked by the testcase builder scripts
1409    # (e.g., gmonster[12].exp).
1410    # It is not invoked by the testcase runner scripts
1411    # (e.g., gmonster[12]-*.exp).
1412
1413    proc standard_compile_driver { exp_file_name make_config_thunk_name } {
1414	global GDB_PERFTEST_MODE GDB_PERFTEST_SUBMODE
1415	if ![info exists GDB_PERFTEST_SUBMODE] {
1416	    # Probably a plain "make check-perf", nothing to do.
1417	    # Give the user a reason why we're not running this test.
1418	    verbose -log "Test must be compiled/run in separate steps."
1419	    return 0
1420	}
1421	switch -glob -- "$GDB_PERFTEST_MODE/$GDB_PERFTEST_SUBMODE" {
1422	    compile/gen-workers {
1423		if { [GenPerfTest::gen_worker_files $exp_file_name] < 0 } {
1424		    fail $GDB_PERFTEST_MODE
1425		    return -1
1426		}
1427		pass $GDB_PERFTEST_MODE
1428	    }
1429	    compile/build-pieces {
1430		array set testcase [$make_config_thunk_name]
1431		global PROGRAM_NAME WORKER_NR
1432		if { [GenPerfTest::compile_pieces testcase $WORKER_NR] < 0 } {
1433		    fail $GDB_PERFTEST_MODE
1434		    # This gdb.log lives in a different place, help the user
1435		    # find it.
1436		    set output_dir "gdb.perf/outputs"
1437		    send_user "check ${output_dir}/${PROGRAM_NAME}/${PROGRAM_NAME}-${WORKER_NR}/gdb.log\n"
1438		    return -1
1439		}
1440		pass $GDB_PERFTEST_MODE
1441	    }
1442	    compile/final {
1443		array set testcase [$make_config_thunk_name]
1444		if { [GenPerfTest::compile testcase] < 0 } {
1445		    fail $GDB_PERFTEST_MODE
1446		    return -1
1447		}
1448		pass $GDB_PERFTEST_MODE
1449	    }
1450	    run/* - both/* {
1451		# Since the builder script is a .exp file living in gdb.perf
1452		# we can get here (dejagnu will find this file for a default
1453		# "make check-perf").  We can also get here when
1454		# standard_run_driver loads the builder .exp file.
1455	    }
1456	    default {
1457		error "Bad value for GDB_PERFTEST_MODE/GDB_PERFTEST_SUBMODE: $GDB_PERFTEST_MODE/$GDB_PERFTEST_SUBMODE"
1458	    }
1459	}
1460	return 0
1461    }
1462
1463    # This function is invoked by the testcase runner scripts
1464    # (e.g., gmonster[12]-*.exp).
1465    # It is not invoked by the testcase builder scripts
1466    # (e.g., gmonster[12].exp).
1467    #
1468    # These tests are built separately with
1469    # "make build-perf" and run with
1470    # "make check-perf GDB_PERFTEST_MODE=run".
1471    # Eventually we can support GDB_PERFTEST_MODE=both, but for now we don't.
1472
1473    proc standard_run_driver { builder_exp_file_name make_config_thunk_name py_file_name test_class_name } {
1474	global GDB_PERFTEST_MODE
1475	# First step is to compile the test.
1476	switch $GDB_PERFTEST_MODE {
1477	    compile - both {
1478		# Here is where we'd add code to support a plain
1479		# "make check-perf".
1480	    }
1481	    run {
1482	    }
1483	    default {
1484		error "Bad value for GDB_PERFTEST_MODE: $GDB_PERFTEST_MODE"
1485	    }
1486	}
1487	# Now run the test.
1488	switch $GDB_PERFTEST_MODE {
1489	    compile {
1490	    }
1491	    both {
1492		# Give the user a reason why we're not running this test.
1493		verbose -log "Test must be compiled/run in separate steps."
1494	    }
1495	    run {
1496		if { [GenPerfTest::run $builder_exp_file_name $make_config_thunk_name $py_file_name $test_class_name] < 0 } {
1497		    fail $GDB_PERFTEST_MODE
1498		    return -1
1499		}
1500		pass $GDB_PERFTEST_MODE
1501	    }
1502	}
1503	return 0
1504    }
1505}
1506
1507if ![info exists PERF_TEST_COMPILE_PARALLELISM] {
1508    set PERF_TEST_COMPILE_PARALLELISM $GenPerfTest::DEFAULT_PERF_TEST_COMPILE_PARALLELISM
1509}
1510