1# Copyright 2004-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
16load_lib libgloss.exp
17
18# FIXME:brobecker/2004-03-31:
19# The following functions should eventually be part of dejagnu. Even after
20# these functions becomes available in dejagnu, we will keep for a while
21# a copy here in order to avoid increasing the dejagnu version
22# requirement.
23
24proc gdb_find_gnatmake {} {
25    global tool_root_dir
26
27    set root "$tool_root_dir/gcc"
28    set GM ""
29
30    if ![is_remote host] {
31        set file [lookfor_file $root gnatmake]
32        if { $file != "" } {
33            set GM "$file -I$root/ada/rts --GCC=$root/xgcc --GNATBIND=$root/gnatbind --GNATLINK=$root/gnatlink -cargs -B$root -largs --GCC=$root/xgcc -margs";
34        }
35    }
36
37    if {$GM == ""} {
38        set GM [transform gnatmake]
39    }
40
41    return $GM
42}
43
44proc gdb_find_gdc {} {
45    global tool_root_dir
46    print "Tool Root: $tool_root_dir"
47
48    if {![is_remote host]} {
49	set file [lookfor_file $tool_root_dir gdc]
50	if { $file == "" } {
51	    set file [lookfor_file $tool_root_dir gcc/gdc]
52	}
53	if { $file != "" } {
54	    set CC "$file -B[file dirname $file]/"
55	} else {
56	    set CC [transform gdc]
57	}
58    } else {
59	set CC [transform gdc]
60    }
61    print "CC: $CC"
62    return $CC
63}
64
65proc gdb_find_gfortran {} {
66    global tool_root_dir
67
68    if {![is_remote host]} {
69	set file [lookfor_file $tool_root_dir gfortran]
70	if { $file == "" } {
71	    set file [lookfor_file $tool_root_dir gcc/gfortran]
72	}
73	if { $file != "" } {
74	    set CC "$file -B[file dirname $file]/"
75	} else {
76	    set CC [transform gfortran]
77	}
78    } else {
79	set CC [transform gfortran]
80    }
81    return $CC
82}
83
84proc gdb_find_go {} {
85    global tool_root_dir
86
87    set GO ""
88
89    if {![is_remote host]} {
90	set file [lookfor_file $tool_root_dir gccgo]
91	if { $file != "" } {
92	    set root [file dirname $file]
93	    set GO "$file -B$root/gcc/"
94	}
95    }
96
97    if { $GO == "" } {
98	set GO [transform gccgo]
99    }
100
101    return $GO
102}
103
104proc gdb_find_go_linker {} {
105    return [find_go]
106}
107
108proc gdb_find_rustc {} {
109    global tool_root_dir
110    if {![is_remote host]} {
111	set rustc [lookfor_file $tool_root_dir rustc]
112	if {$rustc == ""} {
113	    set rustc rustc
114	}
115    } else {
116	set rustc ""
117    }
118    if {$rustc != ""} {
119	append rustc " --color never"
120    }
121    return $rustc
122}
123
124proc gdb_find_ldd {} {
125    global LDD_FOR_TARGET
126    if [info exists LDD_FOR_TARGET] {
127	set ldd $LDD_FOR_TARGET
128    } else {
129	set ldd "ldd"
130    }
131    return $ldd
132}
133
134proc gdb_find_objcopy {} {
135    global OBJCOPY_FOR_TARGET
136    if [info exists OBJCOPY_FOR_TARGET] {
137	set objcopy $OBJCOPY_FOR_TARGET
138    } else {
139	set objcopy [transform objcopy]
140    }
141    return $objcopy
142}
143
144# find target objdump
145proc gdb_find_objdump {} {
146    global OBJDUMP_FOR_TARGET
147    if [info exists OBJDUMP_FOR_TARGET] {
148	set objdump $OBJDUMP_FOR_TARGET
149    } else {
150	set objdump [transform objdump]
151    }
152    return $objdump
153}
154
155proc gdb_find_readelf {} {
156    global READELF_FOR_TARGET
157    if [info exists READELF_FOR_TARGET] {
158	set readelf $READELF_FOR_TARGET
159    } else {
160	set readelf [transform readelf]
161    }
162    return $readelf
163}
164
165proc gdb_find_eu-unstrip {} {
166    global EU_UNSTRIP_FOR_TARGET
167    if [info exists EU_UNSTRIP_FOR_TARGET] {
168	set eu_unstrip $EU_UNSTRIP_FOR_TARGET
169    } else {
170	set eu_unstrip [transform eu-unstrip]
171    }
172    return $eu_unstrip
173}
174
175# Local version of default_target_compile, to be used for languages that
176# dejagnu's default_target_compile doesn't support.
177proc gdb_default_target_compile_1 {source destfile type options} {
178    global target_triplet
179    global tool_root_dir
180    global CFLAGS_FOR_TARGET
181    global compiler_flags
182
183    if { $destfile == "" && $type != "preprocess" && $type != "none" } {
184	error "Must supply an output filename for the compile to default_target_compile"
185    }
186
187    set early_flags ""
188    set add_flags ""
189    set libs ""
190    set compiler_type "c"
191    set compiler ""
192    set linker ""
193    # linker_opts_order is one of "sources-then-flags", "flags-then-sources".
194    # The order matters for things like -Wl,--as-needed.  The default is to
195    # preserve existing behavior.
196    set linker_opts_order "sources-then-flags"
197    set ldflags ""
198    set dest [target_info name]
199
200    if {[info exists CFLAGS_FOR_TARGET]} {
201	append add_flags " $CFLAGS_FOR_TARGET"
202    }
203
204    if {[info exists target_info(host,name)]} {
205	set host [host_info name]
206    } else {
207	set host "unix"
208    }
209
210    foreach i $options {
211
212	if { $i == "ada" } {
213	    set compiler_type "ada"
214	    if {[board_info $dest exists adaflags]} {
215		append add_flags " [target_info adaflags]"
216	    }
217	    if {[board_info $dest exists gnatmake]} {
218		set compiler [target_info gnatmake]
219	    } else {
220		set compiler [find_gnatmake]
221	    }
222	}
223
224	if { $i == "c++" } {
225	    set compiler_type "c++"
226	    if {[board_info $dest exists cxxflags]} {
227		append add_flags " [target_info cxxflags]"
228	    }
229	    append add_flags " [g++_include_flags]"
230	    if {[board_info $dest exists c++compiler]} {
231		set compiler [target_info c++compiler]
232	    } else {
233		set compiler [find_g++]
234	    }
235	}
236
237	if { $i == "d" } {
238	    set compiler_type "d"
239	    if {[board_info $dest exists dflags]} {
240		append add_flags " [target_info dflags]"
241	    }
242	    if {[board_info $dest exists dcompiler]} {
243		set compiler [target_info dcompiler]
244	    } else {
245		set compiler [find_gdc]
246	    }
247	}
248
249	if { $i == "f77" } {
250	    set compiler_type "f77"
251	    if {[board_info $dest exists f77flags]} {
252		append add_flags " [target_info f77flags]"
253	    }
254	    if {[board_info $dest exists f77compiler]} {
255		set compiler [target_info f77compiler]
256	    } else {
257		set compiler [find_g77]
258	    }
259	}
260
261	if { $i == "f90" } {
262	    set compiler_type "f90"
263	    if {[board_info $dest exists f90flags]} {
264		append add_flags " [target_info f90flags]"
265	    }
266	    if {[board_info $dest exists f90compiler]} {
267		set compiler [target_info f90compiler]
268	    } else {
269		set compiler [find_gfortran]
270	    }
271	}
272
273	if { $i == "go" } {
274	    set compiler_type "go"
275	    if {[board_info $dest exists goflags]} {
276		append add_flags " [target_info goflags]"
277	    }
278	    if {[board_info $dest exists gocompiler]} {
279		set compiler [target_info gocompiler]
280	    } else {
281		set compiler [find_go]
282	    }
283	    if {[board_info $dest exists golinker]} {
284		set linker [target_info golinker]
285	    } else {
286		set linker [find_go_linker]
287	    }
288	    if {[board_info $dest exists golinker_opts_order]} {
289		set linker_opts_order [target_info golinker_opts_order]
290	    }
291	}
292
293	if { $i == "rust" } {
294	    set compiler_type "rust"
295	    if {[board_info $dest exists rustflags]} {
296		append add_flags " [target_info rustflags]"
297	    }
298	    if {[board_info $dest exists rustflags]} {
299		set compiler [target_info rustflags]
300	    } else {
301		set compiler [find_rustc]
302	    }
303	}
304
305	if {[regexp "^dest=" $i]} {
306	    regsub "^dest=" $i "" tmp
307	    if {[board_info $tmp exists name]} {
308		set dest [board_info $tmp name]
309	    } else {
310		set dest $tmp
311	    }
312	}
313	if {[regexp "^compiler=" $i]} {
314	    regsub "^compiler=" $i "" tmp
315	    set compiler $tmp
316	}
317	if {[regexp "^early_flags=" $i]} {
318	    regsub "^early_flags=" $i "" tmp
319	    append early_flags " $tmp"
320	}
321	if {[regexp "^additional_flags=" $i]} {
322	    regsub "^additional_flags=" $i "" tmp
323	    append add_flags " $tmp"
324	}
325	if {[regexp "^ldflags=" $i]} {
326	    regsub "^ldflags=" $i "" tmp
327	    append ldflags " $tmp"
328	}
329	if {[regexp "^libs=" $i]} {
330	    regsub "^libs=" $i "" tmp
331	    append libs " $tmp"
332	}
333	if {[regexp "^incdir=" $i]} {
334	    regsub "^incdir=" $i "-I" tmp
335	    append add_flags " $tmp"
336	}
337	if {[regexp "^libdir=" $i]} {
338	    regsub "^libdir=" $i "-L" tmp
339	    append add_flags " $tmp"
340	}
341	if {[regexp "^ldscript=" $i]} {
342	    regsub "^ldscript=" $i "" ldscript
343	}
344	if {[regexp "^redirect=" $i]} {
345	    regsub "^redirect=" $i "" redirect
346	}
347	if {[regexp "^optimize=" $i]} {
348	    regsub "^optimize=" $i "" optimize
349	}
350	if {[regexp "^timeout=" $i]} {
351	    regsub "^timeout=" $i "" timeout
352	}
353    }
354
355    if {[board_info $host exists cflags_for_target]} {
356	append add_flags " [board_info $host cflags_for_target]"
357    }
358
359    global CC_FOR_TARGET
360    global CXX_FOR_TARGET
361    global D_FOR_TARGET
362    global F77_FOR_TARGET
363    global F90_FOR_TARGET
364    global GNATMAKE_FOR_TARGET
365    global GO_FOR_TARGET
366    global GO_LD_FOR_TARGET
367    global RUSTC_FOR_TARGET
368
369    if {[info exists GNATMAKE_FOR_TARGET]} {
370	if { $compiler_type == "ada" } {
371	    set compiler $GNATMAKE_FOR_TARGET
372	}
373    }
374
375    if {[info exists CC_FOR_TARGET]} {
376	if { $compiler == "" } {
377	    set compiler $CC_FOR_TARGET
378	}
379    }
380
381    if {[info exists CXX_FOR_TARGET]} {
382	if { $compiler_type == "c++" } {
383	    set compiler $CXX_FOR_TARGET
384	}
385    }
386
387    if {[info exists D_FOR_TARGET]} {
388	if { $compiler_type == "d" } {
389	    set compiler $D_FOR_TARGET
390	}
391    }
392
393    if {[info exists F77_FOR_TARGET]} {
394	if { $compiler_type == "f77" } {
395	    set compiler $F77_FOR_TARGET
396	}
397    }
398
399    if {[info exists F90_FOR_TARGET]} {
400	if { $compiler_type == "f90" } {
401	    set compiler $F90_FOR_TARGET
402	}
403    }
404
405    if { $compiler_type == "go" } {
406	if {[info exists GO_FOR_TARGET]} {
407	    set compiler $GO_FOR_TARGET
408	}
409	if {[info exists GO_LD_FOR_TARGET]} {
410	    set linker $GO_LD_FOR_TARGET
411	}
412    }
413
414    if {[info exists RUSTC_FOR_TARGET]} {
415	if {$compiler_type == "rust"} {
416	    set compiler $RUSTC_FOR_TARGET
417	}
418    }
419
420    if { $type == "executable" && $linker != "" } {
421	set compiler $linker
422    }
423
424    if { $compiler == "" } {
425	set compiler [board_info $dest compiler]
426	if { $compiler == "" } {
427	    return "default_target_compile: No compiler to compile with"
428	}
429    }
430
431    if {![is_remote host]} {
432	if { [which $compiler] == 0 } {
433	    return "default_target_compile: Can't find $compiler."
434	}
435    }
436
437    if {$type == "object"} {
438	if {$compiler_type == "rust"} {
439	    append add_flags "--emit obj"
440	} else {
441	    append add_flags " -c"
442	}
443    }
444
445    if { $type == "preprocess" } {
446	append add_flags " -E"
447    }
448
449    if { $type == "assembly" } {
450	append add_flags " -S"
451    }
452
453    if {[board_info $dest exists cflags]} {
454	append add_flags " [board_info $dest cflags]"
455    }
456
457    if { $type == "executable" } {
458	if {[board_info $dest exists ldflags]} {
459	    append add_flags " [board_info $dest ldflags]"
460	}
461	if { $compiler_type == "c++" } {
462	    append add_flags " [g++_link_flags]"
463	}
464	if {[isnative]} {
465	    # This is a lose.
466	    catch "glob -nocomplain $tool_root_dir/libstdc++/libstdc++.so* $tool_root_dir/libstdc++/libstdc++.sl" tmp
467	    if { ${tmp} != "" } {
468		if {[regexp ".*solaris2.*" $target_triplet]} {
469		    # Solaris 2
470		    append add_flags " -R$tool_root_dir/libstdc++"
471		} elseif {[regexp ".*(osf|irix5|linux).*" $target_triplet]} {
472		    # OSF/1 or IRIX 5
473		    append add_flags " -Wl,-rpath,$tool_root_dir/libstdc++"
474		}
475	    }
476	}
477    }
478
479    if {![info exists ldscript]} {
480	set ldscript [board_info $dest ldscript]
481    }
482
483    foreach i $options {
484	if { $i == "debug" } {
485	    if {[board_info $dest exists debug_flags]} {
486		append add_flags " [board_info $dest debug_flags]"
487	    } else {
488		append add_flags " -g"
489	    }
490	}
491    }
492
493    if {[info exists optimize]} {
494	append add_flags " $optimize"
495    }
496
497    if { $type == "executable" } {
498	append add_flags " $ldflags"
499	foreach x $libs {
500	    if {[file exists $x]} {
501		append source " $x"
502	    } else {
503		append add_flags " $x"
504	    }
505	}
506
507	if {[board_info $dest exists libs]} {
508	    append add_flags " [board_info $dest libs]"
509	}
510
511	# This probably isn't such a good idea, but it avoids nasty
512	# hackiness in the testsuites.
513	# The math library must be linked in before the C library.  The C
514	# library is linked in by the linker script, so this must be before
515	# the linker script.
516	if {[board_info $dest exists mathlib]} {
517	    append add_flags " [board_info $dest mathlib]"
518	} else {
519	    append add_flags " -lm"
520	}
521
522	# This must be added here.
523	append add_flags " $ldscript"
524
525	if {[board_info $dest exists remote_link]} {
526	    # Relink option.
527	    append add_flags " -Wl,-r"
528	}
529	if {[board_info $dest exists output_format]} {
530	    append add_flags " -Wl,-oformat,[board_info $dest output_format]"
531	}
532    }
533
534    if {[board_info $dest exists multilib_flags]} {
535	append add_flags " [board_info $dest multilib_flags]"
536    }
537
538    verbose "doing compile"
539
540    set sources ""
541    if {[is_remote host]} {
542	foreach x $source {
543	    set file [remote_download host $x]
544	    if { $file == "" } {
545		warning "Unable to download $x to host."
546		return "Unable to download $x to host."
547	    } else {
548		append sources " $file"
549	    }
550	}
551    } else {
552	set sources $source
553    }
554
555    if {[is_remote host]} {
556	append add_flags " -o " [file tail $destfile]
557	remote_file host delete [file tail $destfile]
558    } else {
559	if { $destfile != "" } {
560	    append add_flags " -o $destfile"
561	}
562    }
563
564    # This is obscure: we put SOURCES at the end when building an
565    # object, because otherwise, in some situations, libtool will
566    # become confused about the name of the actual source file.
567    switch $type {
568	"object" {
569	    set opts "$early_flags $add_flags $sources"
570	}
571	"executable" {
572	    switch $linker_opts_order {
573		"flags-then-sources" {
574		    set opts "$early_flags $add_flags $sources"
575		}
576		"sources-then-flags" {
577		    set opts "$early_flags $sources $add_flags"
578		}
579		default {
580		    error "Invalid value for board_info linker_opts_order"
581		}
582	    }
583	}
584	default {
585	    set opts "$early_flags $sources $add_flags"
586	}
587    }
588
589    if {[is_remote host]} {
590	if {[host_info exists use_at]} {
591	    set fid [open "atfile" "w"]
592	    puts $fid "$opts"
593	    close $fid
594	    set opts "@[remote_download host atfile]"
595	    remote_file build delete atfile
596	}
597    }
598
599    verbose "Invoking the compiler as $compiler $opts" 2
600
601    if {[info exists redirect]} {
602	verbose "Redirecting output to $redirect" 2
603	set status [remote_exec host "$compiler $opts" "" "" $redirect]
604    } else {
605	if {[info exists timeout]} {
606	    verbose "Setting timeout to $timeout" 2
607	    set status [remote_exec host "$compiler $opts" "" "" "" $timeout]
608	} else {
609	    set status [remote_exec host "$compiler $opts"]
610	}
611    }
612
613    set compiler_flags $opts
614    if {[is_remote host]} {
615	remote_upload host [file tail $destfile] $destfile
616	remote_file host delete [file tail $destfile]
617    }
618    set comp_output [prune_warnings [lindex $status 1]]
619    regsub "^\[\r\n\]+" $comp_output "" comp_output
620    if { [lindex $status 0] != 0 } {
621	verbose -log "compiler exited with status [lindex $status 0]"
622    }
623    if { [lindex $status 1] != "" } {
624	verbose -log "output is:\n[lindex $status 1]" 2
625    }
626    if { [lindex $status 0] != 0 && "${comp_output}" == "" } {
627	set comp_output "exit status is [lindex $status 0]"
628    }
629    return ${comp_output}
630}
631
632# If dejagnu's default_target_compile supports the language specified in
633# OPTIONS, use it.  Otherwise, use gdb_default_target_compile_1.
634proc gdb_default_target_compile {source destfile type options} {
635    global use_gdb_compile
636
637    set need_local_lang 0
638    set need_local_early_flags 0
639    foreach i $options {
640
641	if { $i == "ada" || $i == "d" || $i == "go" || $i == "rust" } {
642	    set need_local_lang [info exists use_gdb_compile($i)]
643	}
644
645	if { $i == "c++" } {
646	    set need_local_lang 0
647	}
648
649	if { $i == "f77" || $i == "f90" } {
650	    set need_local_lang [info exists use_gdb_compile(fortran)]
651	}
652
653	if { [regexp "^early_flags=" $i] } {
654	    set need_local_early_flags 1
655	}
656    }
657
658    if { $need_local_lang || $need_local_early_flags } {
659	return [gdb_default_target_compile_1 $source $destfile $type $options]
660    }
661
662    return [dejagnu_default_target_compile $source $destfile $type $options]
663}
664
665# Array of languages for which dejagnu's default_target_compile is missing
666# support.
667array set use_gdb_compile [list]
668
669# Note missing support in dejagnu's default_target_compile.  This
670# needs to be fixed by porting the missing support to Dejagnu.
671set note_prefix "Dejagnu's default_target_compile is missing support for "
672set note_suffix ", using local override"
673
674if {[info procs find_gnatmake] == ""} {
675    rename gdb_find_gnatmake find_gnatmake
676    set use_gdb_compile(ada) 1
677    gdb_note [join [list $note_prefix "Ada" $note_suffix] ""]
678}
679
680if {[info procs find_gfortran] == ""} {
681    rename gdb_find_gfortran find_gfortran
682    set use_gdb_compile(fortran) 1
683    gdb_note [join [list $note_prefix "Fortran" $note_suffix] ""]
684}
685
686if {[info procs find_go_linker] == ""} {
687    rename gdb_find_go find_go
688    rename gdb_find_go_linker find_go_linker
689    set use_gdb_compile(go) 1
690    gdb_note [join [list $note_prefix "Go" $note_suffix] ""]
691}
692
693if {[info procs find_gdc] == ""} {
694    rename gdb_find_gdc find_gdc
695    set use_gdb_compile(d) 1
696    gdb_note [join [list $note_prefix "D" $note_suffix] ""]
697}
698
699if {[info procs find_rustc] == ""} {
700    rename gdb_find_rustc find_rustc
701    set use_gdb_compile(rust) 1
702    gdb_note [join [list $note_prefix "Rust" $note_suffix] ""]
703}
704
705# If dejagnu's default_target_compile is missing support for any language,
706# override it.
707if { [array size use_gdb_compile] != 0 } {
708    catch {rename default_target_compile dejagnu_default_target_compile}
709    rename gdb_default_target_compile default_target_compile
710}
711
712
713# Provide 'lreverse' missing in Tcl before 7.5.
714
715if {[info procs lreverse] == ""} {
716    proc lreverse { arg } {
717	set retval {}
718	while { [llength $retval] < [llength $arg] } {
719	    lappend retval [lindex $arg end-[llength $retval]]
720	}
721	return $retval
722    }
723}
724
725# Various ccache versions provide incorrect debug info such as ignoring
726# different current directory, breaking GDB testsuite.
727set env(CCACHE_DISABLE) 1
728unset -nocomplain env(CCACHE_NODISABLE)
729