1769 lines
40 KiB
Plaintext
1769 lines
40 KiB
Plaintext
# Expect script for creating PDB files when linking.
|
|
# Copyright (C) 2022 Free Software Foundation, Inc.
|
|
#
|
|
# This file is part of the GNU Binutils.
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, write to the Free Software
|
|
# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
|
|
# MA 02110-1301, USA.
|
|
|
|
if {![istarget i*86-*-mingw*]
|
|
&& ![istarget x86_64-*-mingw*]} {
|
|
return
|
|
}
|
|
|
|
proc get_pdb_name { pe } {
|
|
global OBJDUMP
|
|
|
|
set exec_output [run_host_cmd "$OBJDUMP" "-p $pe"]
|
|
|
|
if ![regexp -line "^\\(format RSDS signature (\[0-9a-fA-F\]{32}) age 1 pdb (.*)\\)$" $exec_output full sig pdb] {
|
|
return ""
|
|
}
|
|
|
|
return $pdb
|
|
}
|
|
|
|
proc get_pdb_guid { pe } {
|
|
global OBJDUMP
|
|
|
|
set exec_output [run_host_cmd "$OBJDUMP" "-p $pe"]
|
|
|
|
if ![regexp -line "^\\(format RSDS signature (\[0-9a-fA-F\]{32}) age 1 pdb (.*)\\)$" $exec_output full sig pdb] {
|
|
return ""
|
|
}
|
|
|
|
return $sig
|
|
}
|
|
|
|
proc check_pdb_info_stream { pdb guid } {
|
|
global ar
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0001"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
return 0
|
|
}
|
|
|
|
set fi [open tmpdir/0001]
|
|
fconfigure $fi -translation binary
|
|
|
|
# check version
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i version
|
|
|
|
if { $version != 20000404 } {
|
|
close $fi
|
|
return 0
|
|
}
|
|
|
|
# skip signature (timestamp)
|
|
read $fi 4
|
|
|
|
# check age
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i age
|
|
|
|
if { $age != 1 } {
|
|
close $fi
|
|
return 0
|
|
}
|
|
|
|
# check GUID
|
|
|
|
set data [read $fi 16]
|
|
binary scan $data H2H2H2H2H2H2H2H2H* guid1 guid2 guid3 guid4 guid5 guid6 guid7 guid8 guid9
|
|
|
|
set data "$guid4$guid3$guid2$guid1$guid6$guid5$guid8$guid7$guid9"
|
|
|
|
if { $data ne $guid } {
|
|
close $fi
|
|
return 0
|
|
}
|
|
|
|
# skip names string
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i names_length
|
|
read $fi $names_length
|
|
|
|
# read number of names entries
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i num_entries
|
|
|
|
# skip number of buckets
|
|
read $fi 4
|
|
|
|
# skip present bitmap
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i bitmap_length
|
|
read $fi [expr $bitmap_length * 4]
|
|
|
|
# skip deleted bitmap
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i bitmap_length
|
|
read $fi [expr $bitmap_length * 4]
|
|
|
|
# skip names entries
|
|
read $fi [expr $num_entries * 8]
|
|
|
|
# skip uint32_t
|
|
read $fi 4
|
|
|
|
# read second version
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i version2
|
|
|
|
if { $version2 != 20140508 } {
|
|
close $fi
|
|
return 0
|
|
}
|
|
|
|
close $fi
|
|
|
|
return 1
|
|
}
|
|
|
|
proc check_type_stream { pdb stream } {
|
|
global ar
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb $stream"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
return 0
|
|
}
|
|
|
|
set fi [open tmpdir/$stream]
|
|
fconfigure $fi -translation binary
|
|
|
|
# check version
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i version
|
|
|
|
if { $version != 20040203 } {
|
|
close $fi
|
|
return 0
|
|
}
|
|
|
|
# check header size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i header_size
|
|
|
|
if { $header_size != 0x38 } {
|
|
close $fi
|
|
return 0
|
|
}
|
|
|
|
# skip type_index_begin and type_index_end
|
|
read $fi 8
|
|
|
|
# read type_record_bytes
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i type_record_bytes
|
|
|
|
close $fi
|
|
|
|
# check stream length
|
|
|
|
set stream_length [file size tmpdir/$stream]
|
|
|
|
if { $stream_length != [ expr $header_size + $type_record_bytes ] } {
|
|
return 0
|
|
}
|
|
|
|
return 1
|
|
}
|
|
|
|
proc check_dbi_stream { pdb } {
|
|
global ar
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0003"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
return 0
|
|
}
|
|
|
|
set fi [open tmpdir/0003]
|
|
fconfigure $fi -translation binary
|
|
|
|
# check signature
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i signature
|
|
|
|
if { $signature != -1 } {
|
|
close $fi
|
|
return 0
|
|
}
|
|
|
|
# check version
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i version
|
|
|
|
if { $version != 19990903 } {
|
|
close $fi
|
|
return 0
|
|
}
|
|
|
|
# check age
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i age
|
|
|
|
if { $age != 1 } {
|
|
close $fi
|
|
return 0
|
|
}
|
|
|
|
# skip fields
|
|
read $fi 12
|
|
|
|
# read substream sizes
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i mod_info_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i section_contribution_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i section_map_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i source_info_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i type_server_map_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i mfc_type_server_index
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i optional_dbg_header_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i ec_substream_size
|
|
|
|
close $fi
|
|
|
|
# check stream length
|
|
|
|
set stream_length [file size tmpdir/0003]
|
|
|
|
if { $stream_length != [expr 0x40 + $mod_info_size + $section_contribution_size + $section_map_size + $source_info_size + $type_server_map_size + $mfc_type_server_index + $optional_dbg_header_size + $ec_substream_size] } {
|
|
return 0
|
|
}
|
|
|
|
return 1
|
|
}
|
|
|
|
proc get_section_stream_index { pdb } {
|
|
global ar
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0003"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
return -1
|
|
}
|
|
|
|
set fi [open tmpdir/0003]
|
|
fconfigure $fi -translation binary
|
|
|
|
# skip fields
|
|
seek $fi 24
|
|
|
|
# read substream sizes
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i mod_info_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i section_contribution_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i section_map_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i source_info_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i type_server_map_size
|
|
|
|
# skip type server index
|
|
seek $fi 4 current
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i optional_dbg_header_size
|
|
|
|
if { $optional_dbg_header_size < 12 } {
|
|
close $fi
|
|
return -1
|
|
}
|
|
|
|
# skip data
|
|
seek $fi [expr 12 + $mod_info_size + $section_contribution_size + $section_map_size + $source_info_size + $type_server_map_size + 10] current
|
|
|
|
set data [read $fi 2]
|
|
binary scan $data s section_stream_index
|
|
|
|
close $fi
|
|
|
|
return $section_stream_index
|
|
}
|
|
|
|
proc check_section_stream { img pdb } {
|
|
global ar
|
|
|
|
# read sections stream
|
|
|
|
set index [get_section_stream_index $pdb]
|
|
|
|
if { $index == -1 } {
|
|
return 0
|
|
}
|
|
|
|
set index_str [format "%04x" $index]
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb $index_str"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
return 0
|
|
}
|
|
|
|
set stream_length [file size tmpdir/$index_str]
|
|
|
|
set fi [open tmpdir/$index_str]
|
|
fconfigure $fi -translation binary
|
|
|
|
set stream_data [read $fi $stream_length]
|
|
|
|
close $fi
|
|
|
|
# read sections from PE file
|
|
|
|
set fi [open $img]
|
|
fconfigure $fi -translation binary
|
|
|
|
# read PE offset
|
|
read $fi 0x3c
|
|
set data [read $fi 4]
|
|
binary scan $data i pe_offset
|
|
|
|
# read number of sections
|
|
seek $fi [expr $pe_offset + 6]
|
|
set data [read $fi 2]
|
|
binary scan $data s num_sections
|
|
|
|
# read size of optional header
|
|
seek $fi 12 current
|
|
set data [read $fi 2]
|
|
binary scan $data s opt_header_size
|
|
|
|
# read section headers
|
|
seek $fi [expr $opt_header_size + 2] current
|
|
set section_data [read $fi [expr $num_sections * 40]]
|
|
|
|
close $fi
|
|
|
|
# compare
|
|
|
|
if { $stream_data ne $section_data} {
|
|
return 0
|
|
}
|
|
|
|
return 1
|
|
}
|
|
|
|
proc get_publics_stream_index { pdb } {
|
|
global ar
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0003"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
return -1
|
|
}
|
|
|
|
set fi [open tmpdir/0003]
|
|
fconfigure $fi -translation binary
|
|
|
|
# skip fields
|
|
seek $fi 16
|
|
|
|
# read substream sizes
|
|
|
|
set data [read $fi 2]
|
|
binary scan $data s index
|
|
|
|
close $fi
|
|
|
|
return $index
|
|
}
|
|
|
|
proc get_sym_record_stream_index { pdb } {
|
|
global ar
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0003"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
return -1
|
|
}
|
|
|
|
set fi [open tmpdir/0003]
|
|
fconfigure $fi -translation binary
|
|
|
|
# skip fields
|
|
seek $fi 20
|
|
|
|
# read substream sizes
|
|
|
|
set data [read $fi 2]
|
|
binary scan $data s index
|
|
|
|
close $fi
|
|
|
|
return $index
|
|
}
|
|
|
|
proc check_publics_stream { pdb } {
|
|
global ar
|
|
global objdump
|
|
global srcdir
|
|
global subdir
|
|
|
|
set publics_index [get_publics_stream_index $pdb]
|
|
|
|
if { $publics_index == -1 } {
|
|
return 0
|
|
}
|
|
|
|
set index_str [format "%04x" $publics_index]
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb $index_str"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
return 0
|
|
}
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb1-publics.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
|
|
if ![string match $exp $got] {
|
|
return 0
|
|
}
|
|
|
|
set sym_record_index [get_sym_record_stream_index $pdb]
|
|
|
|
if { $sym_record_index == -1 } {
|
|
return 0
|
|
}
|
|
|
|
set index_str [format "%04x" $sym_record_index]
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb $index_str"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
return 0
|
|
}
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb1-sym-record.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
|
|
if ![string match $exp $got] {
|
|
return 0
|
|
}
|
|
|
|
return 1
|
|
}
|
|
|
|
proc test1 { } {
|
|
global as
|
|
global ld
|
|
global srcdir
|
|
global subdir
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb1.s tmpdir/pdb1.o] {
|
|
unsupported "Build pdb1.o"
|
|
return
|
|
}
|
|
|
|
if ![ld_link $ld "tmpdir/pdb1.exe" "--pdb=tmpdir/pdb1.pdb --gc-sections -e foo tmpdir/pdb1.o"] {
|
|
fail "Could not create a PE image with a PDB file"
|
|
return
|
|
}
|
|
|
|
if ![string equal [get_pdb_name "tmpdir/pdb1.exe"] "pdb1.pdb"] {
|
|
fail "PDB filename not found in CodeView debug info"
|
|
return
|
|
}
|
|
|
|
pass "PDB filename present in CodeView debug info"
|
|
|
|
if [check_pdb_info_stream tmpdir/pdb1.pdb [get_pdb_guid "tmpdir/pdb1.exe"]] {
|
|
pass "Valid PDB info stream"
|
|
} else {
|
|
fail "Invalid PDB info stream"
|
|
}
|
|
|
|
if [check_type_stream tmpdir/pdb1.pdb "0002"] {
|
|
pass "Valid TPI stream"
|
|
} else {
|
|
fail "Invalid TPI stream"
|
|
}
|
|
|
|
if [check_type_stream tmpdir/pdb1.pdb "0004"] {
|
|
pass "Valid IPI stream"
|
|
} else {
|
|
fail "Invalid IPI stream"
|
|
}
|
|
|
|
if [check_dbi_stream tmpdir/pdb1.pdb] {
|
|
pass "Valid DBI stream"
|
|
} else {
|
|
fail "Invalid DBI stream"
|
|
}
|
|
|
|
if [check_section_stream tmpdir/pdb1.exe tmpdir/pdb1.pdb] {
|
|
pass "Valid section stream"
|
|
} else {
|
|
fail "Invalid section stream"
|
|
}
|
|
|
|
if [check_publics_stream tmpdir/pdb1.pdb] {
|
|
pass "Valid publics stream"
|
|
} else {
|
|
fail "Invalid publics stream"
|
|
}
|
|
}
|
|
|
|
proc test_mod_info { mod_info } {
|
|
# check filenames in mod_info
|
|
|
|
set off 64
|
|
|
|
set obj1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]]
|
|
incr off [expr [string length $obj1] + 1]
|
|
|
|
set ar1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]]
|
|
incr off [expr [string length $ar1] + 1]
|
|
|
|
if [string match "*pdb2a.o" $obj1] {
|
|
pass "Correct name for first object file"
|
|
} else {
|
|
fail "Incorrect name for first object file"
|
|
}
|
|
|
|
if [string equal $obj1 $ar1] {
|
|
pass "Correct archive name for first object file"
|
|
} else {
|
|
fail "Incorrect archive name for first object file"
|
|
}
|
|
|
|
if { [expr $off % 4] != 0 } {
|
|
set off [expr $off + 4 - ($off % 4)]
|
|
}
|
|
|
|
incr off 64
|
|
|
|
set obj2 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]]
|
|
incr off [expr [string length $obj2] + 1]
|
|
|
|
set ar2 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]]
|
|
incr off [expr [string length $ar2] + 1]
|
|
|
|
if [string match "*pdb2b.o" $obj2] {
|
|
pass "Correct name for second object file"
|
|
} else {
|
|
fail "Incorrect name for second object file"
|
|
}
|
|
|
|
if [string match "*pdb2b.a" $ar2] {
|
|
pass "Correct archive name for second object file"
|
|
} else {
|
|
fail "Incorrect archive name for second object file"
|
|
}
|
|
|
|
if { [expr $off % 4] != 0 } {
|
|
set off [expr $off + 4 - ($off % 4)]
|
|
}
|
|
|
|
incr off 64
|
|
|
|
set obj3 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]]
|
|
incr off [expr [string length $obj3] + 1]
|
|
|
|
set ar3 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]]
|
|
incr off [expr [string length $ar3] + 1]
|
|
|
|
if [string equal $obj3 "* Linker *"] {
|
|
pass "Correct name for dummy object file"
|
|
} else {
|
|
fail "Incorrect name for dummy object file"
|
|
}
|
|
|
|
if [string equal $ar3 ""] {
|
|
pass "Correct archive name for dummy object file"
|
|
} else {
|
|
fail "Incorrect archive name for dummy object file"
|
|
}
|
|
}
|
|
|
|
proc test_section_contrib { section_contrib } {
|
|
global objdump
|
|
global srcdir
|
|
global subdir
|
|
|
|
set fi [open tmpdir/pdb2-sc w]
|
|
fconfigure $fi -translation binary
|
|
puts -nonewline $fi $section_contrib
|
|
close $fi
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb2-section-contrib.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb2-sc"]
|
|
|
|
if [string equal $exp $got] {
|
|
pass "Correct section contribution substream"
|
|
} else {
|
|
fail "Incorrect section contribution substream"
|
|
}
|
|
}
|
|
|
|
proc test2 { } {
|
|
global as
|
|
global ar
|
|
global ld
|
|
global srcdir
|
|
global subdir
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb2a.s tmpdir/pdb2a.o] {
|
|
unsupported "Build pdb2a.o"
|
|
return
|
|
}
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb2b.s tmpdir/pdb2b.o] {
|
|
unsupported "Build pdb2b.o"
|
|
return
|
|
}
|
|
|
|
set exec_output [run_host_cmd "$ar" "cr tmpdir/pdb2b.a tmpdir/pdb2b.o"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
unsupported "Create pdb2b.a"
|
|
return
|
|
}
|
|
|
|
if ![ld_link $ld "tmpdir/pdb2.exe" "--pdb=tmpdir/pdb2.pdb --gc-sections -e foo tmpdir/pdb2a.o tmpdir/pdb2b.a"] {
|
|
unsupported "Create PE image with PDB file"
|
|
return
|
|
}
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb2.pdb 0003"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
return 0
|
|
}
|
|
|
|
set fi [open tmpdir/0003]
|
|
fconfigure $fi -translation binary
|
|
|
|
seek $fi 24
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i mod_info_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i section_contrib_size
|
|
|
|
seek $fi 32 current
|
|
|
|
set mod_info [read $fi $mod_info_size]
|
|
set section_contrib [read $fi $section_contrib_size]
|
|
|
|
close $fi
|
|
|
|
test_mod_info $mod_info
|
|
test_section_contrib $section_contrib
|
|
}
|
|
|
|
proc find_named_stream { pdb name } {
|
|
global ar
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb 0001"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
return 0
|
|
}
|
|
|
|
set fi [open tmpdir/0001]
|
|
fconfigure $fi -translation binary
|
|
|
|
seek $fi 0x1c
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i string_len
|
|
|
|
set strings [read $fi $string_len]
|
|
|
|
set string_off 0
|
|
|
|
while {[string first \000 $strings $string_off] != -1 } {
|
|
set str [string range $strings $string_off [expr [string first \000 $strings $string_off] - 1]]
|
|
|
|
if { $str eq $name } {
|
|
break
|
|
}
|
|
|
|
incr string_off [expr [string length $str] + 1]
|
|
}
|
|
|
|
if { [string length $strings] == $string_off } { # string not found
|
|
close $fi
|
|
return 0
|
|
}
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i num_entries
|
|
|
|
seek $fi 4 current
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i present_bitmap_len
|
|
|
|
seek $fi [expr $present_bitmap_len * 4] current
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i deleted_bitmap_len
|
|
|
|
seek $fi [expr $deleted_bitmap_len * 4] current
|
|
|
|
for {set i 0} {$i < $num_entries} {incr i} {
|
|
set data [read $fi 4]
|
|
binary scan $data i offset
|
|
|
|
if { $offset == $string_off } {
|
|
set data [read $fi 4]
|
|
binary scan $data i value
|
|
close $fi
|
|
|
|
return $value
|
|
}
|
|
|
|
seek $fi 4 current
|
|
}
|
|
|
|
close $fi
|
|
|
|
return 0
|
|
}
|
|
|
|
proc test3 { } {
|
|
global as
|
|
global ar
|
|
global ld
|
|
global objdump
|
|
global srcdir
|
|
global subdir
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb-strings1.s tmpdir/pdb-strings1.o] {
|
|
unsupported "Build pdb-strings1.o"
|
|
return
|
|
}
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb-strings2.s tmpdir/pdb-strings2.o] {
|
|
unsupported "Build pdb-strings2.o"
|
|
return
|
|
}
|
|
|
|
if ![ld_link $ld "tmpdir/pdb-strings.exe" "--pdb=tmpdir/pdb-strings.pdb tmpdir/pdb-strings1.o tmpdir/pdb-strings2.o"] {
|
|
unsupported "Create PE image with PDB file"
|
|
return
|
|
}
|
|
|
|
set index [find_named_stream "tmpdir/pdb-strings.pdb" "/names"]
|
|
|
|
if { $index == 0 } {
|
|
fail "Could not find /names stream"
|
|
return
|
|
} else {
|
|
pass "Found /names stream"
|
|
}
|
|
|
|
set index_str [format "%04x" $index]
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-strings.pdb $index_str"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
return 0
|
|
}
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb-strings.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
|
|
|
|
if ![string match $exp $got] {
|
|
fail "Strings table was not as expected"
|
|
} else {
|
|
pass "Strings table was as expected"
|
|
}
|
|
}
|
|
|
|
proc extract_c13_info { pdb mod_info } {
|
|
global ar
|
|
|
|
binary scan [string range $mod_info 34 35] s module_sym_stream
|
|
binary scan [string range $mod_info 36 39] i sym_byte_size
|
|
binary scan [string range $mod_info 40 43] i c11_byte_size
|
|
binary scan [string range $mod_info 44 47] i c13_byte_size
|
|
|
|
set index_str [format "%04x" $module_sym_stream]
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir $pdb $index_str"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
return ""
|
|
}
|
|
|
|
set fi [open tmpdir/$index_str]
|
|
fconfigure $fi -translation binary
|
|
|
|
seek $fi [expr $sym_byte_size + $c11_byte_size]
|
|
|
|
set data [read $fi $c13_byte_size]
|
|
|
|
close $fi
|
|
|
|
return $data
|
|
}
|
|
|
|
proc test4 { } {
|
|
global as
|
|
global ar
|
|
global ld
|
|
global objdump
|
|
global srcdir
|
|
global subdir
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb3a.s tmpdir/pdb3a.o] {
|
|
unsupported "Build pdb3a.o"
|
|
return
|
|
}
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb3b.s tmpdir/pdb3b.o] {
|
|
unsupported "Build pdb3b.o"
|
|
return
|
|
}
|
|
|
|
if ![ld_link $ld "tmpdir/pdb3.exe" "--pdb=tmpdir/pdb3.pdb --gc-sections -e main tmpdir/pdb3a.o tmpdir/pdb3b.o"] {
|
|
unsupported "Create PE image with PDB file"
|
|
return
|
|
}
|
|
|
|
# read relevant bits from DBI stream
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb3.pdb 0003"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
fail "Could not extract DBI stream"
|
|
return
|
|
} else {
|
|
pass "Extracted DBI stream"
|
|
}
|
|
|
|
set fi [open tmpdir/0003]
|
|
fconfigure $fi -translation binary
|
|
|
|
seek $fi 24
|
|
|
|
# read substream sizes
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i mod_info_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i section_contribution_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i section_map_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i source_info_size
|
|
|
|
seek $fi 24 current
|
|
|
|
set mod_info [read $fi $mod_info_size]
|
|
|
|
seek $fi [expr $section_contribution_size + $section_map_size] current
|
|
|
|
set source_info [read $fi $source_info_size]
|
|
|
|
close $fi
|
|
|
|
# check source info substream
|
|
|
|
set fi [open tmpdir/pdb3-source-info w]
|
|
fconfigure $fi -translation binary
|
|
puts -nonewline $fi $source_info
|
|
close $fi
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb3-source-info.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb3-source-info"]
|
|
|
|
if [string match $exp $got] {
|
|
pass "Correct source info substream"
|
|
} else {
|
|
fail "Incorrect source info substream"
|
|
}
|
|
|
|
# check C13 info in first module
|
|
|
|
set c13_info [extract_c13_info "tmpdir/pdb3.pdb" [string range $mod_info 0 63]]
|
|
|
|
set fi [open tmpdir/pdb3-c13-info1 w]
|
|
fconfigure $fi -translation binary
|
|
puts -nonewline $fi $c13_info
|
|
close $fi
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb3-c13-info1.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb3-c13-info1"]
|
|
|
|
if [string match $exp $got] {
|
|
pass "Correct C13 info for first module"
|
|
} else {
|
|
fail "Incorrect C13 info for first module"
|
|
}
|
|
|
|
# check C13 info in second module
|
|
|
|
set fn1_end [string first \000 $mod_info 64]
|
|
set fn2_end [string first \000 $mod_info [expr $fn1_end + 1]]
|
|
|
|
set off [expr $fn2_end + 1]
|
|
|
|
if { [expr $off % 4] != 0 } {
|
|
set off [expr $off + 4 - ($off % 4)]
|
|
}
|
|
|
|
set c13_info [extract_c13_info "tmpdir/pdb3.pdb" [string range $mod_info $off [expr $off + 63]]]
|
|
|
|
set fi [open tmpdir/pdb3-c13-info2 w]
|
|
fconfigure $fi -translation binary
|
|
puts -nonewline $fi $c13_info
|
|
close $fi
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb3-c13-info2.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb3-c13-info2"]
|
|
|
|
if [string match $exp $got] {
|
|
pass "Correct C13 info for second module"
|
|
} else {
|
|
fail "Incorrect C13 info for second module"
|
|
}
|
|
}
|
|
|
|
proc test5 { } {
|
|
global as
|
|
global ar
|
|
global ld
|
|
global objdump
|
|
global srcdir
|
|
global subdir
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb-types1a.s tmpdir/pdb-types1a.o] {
|
|
unsupported "Build pdb-types1a.o"
|
|
return
|
|
}
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb-types1b.s tmpdir/pdb-types1b.o] {
|
|
unsupported "Build pdb-types1b.o"
|
|
return
|
|
}
|
|
|
|
if ![ld_link $ld "tmpdir/pdb-types1.exe" "--pdb=tmpdir/pdb-types1.pdb tmpdir/pdb-types1a.o tmpdir/pdb-types1b.o"] {
|
|
unsupported "Create PE image with PDB file"
|
|
return
|
|
}
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types1.pdb 0002"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
fail "Could not extract TPI stream"
|
|
return
|
|
} else {
|
|
pass "Extracted TPI stream"
|
|
}
|
|
|
|
# check values in TPI header, and save anything interesting
|
|
|
|
set fi [open tmpdir/0002]
|
|
fconfigure $fi -translation binary
|
|
|
|
seek $fi 8 current
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i first_type
|
|
|
|
if { $first_type != 0x1000 } {
|
|
fail "Incorrect first type value in TPI stream."
|
|
} else {
|
|
pass "Correct first type value in TPI stream."
|
|
}
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i end_type
|
|
|
|
# end_type is one greater than the last type in the stream
|
|
if { $end_type != 0x1023 } {
|
|
fail "Incorrect end type value in TPI stream."
|
|
} else {
|
|
pass "Correct end type value in TPI stream."
|
|
}
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i type_list_size
|
|
|
|
set data [read $fi 2]
|
|
binary scan $data s hash_stream_index
|
|
|
|
seek $fi 2 current
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i hash_size
|
|
|
|
if { $hash_size != 4 } {
|
|
fail "Incorrect hash size in TPI stream."
|
|
} else {
|
|
pass "Correct hash size in TPI stream."
|
|
}
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i num_buckets
|
|
|
|
if { $num_buckets != 0x3ffff } {
|
|
fail "Incorrect number of buckets in TPI stream."
|
|
} else {
|
|
pass "Correct number of buckets in TPI stream."
|
|
}
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i hash_list_offset
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i hash_list_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i skip_list_offset
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i skip_list_size
|
|
|
|
seek $fi 8 current
|
|
|
|
set type_list [read $fi $type_list_size]
|
|
|
|
close $fi
|
|
|
|
set fi [open tmpdir/pdb-types1-typelist w]
|
|
fconfigure $fi -translation binary
|
|
puts -nonewline $fi $type_list
|
|
close $fi
|
|
|
|
# check type list
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb-types1-typelist.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types1-typelist"]
|
|
if ![string match $exp $got] {
|
|
fail "Incorrect type list in TPI stream."
|
|
} else {
|
|
pass "Correct type list in TPI stream."
|
|
}
|
|
|
|
# extract hash list and skip list
|
|
|
|
set index_str [format "%04x" $hash_stream_index]
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types1.pdb $index_str"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
fail "Could not extract TPI hash stream."
|
|
} else {
|
|
pass "Extracted TPI hash stream."
|
|
}
|
|
|
|
set fi [open tmpdir/$index_str]
|
|
fconfigure $fi -translation binary
|
|
|
|
seek $fi $hash_list_offset
|
|
set hash_list [read $fi $hash_list_size]
|
|
|
|
seek $fi $skip_list_offset
|
|
set skip_list [read $fi $skip_list_size]
|
|
|
|
close $fi
|
|
|
|
# check hash list
|
|
|
|
set fi [open tmpdir/pdb-types1-hashlist w]
|
|
fconfigure $fi -translation binary
|
|
puts -nonewline $fi $hash_list
|
|
close $fi
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb-types1-hashlist.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types1-hashlist"]
|
|
if ![string match $exp $got] {
|
|
fail "Incorrect hash list in TPI stream."
|
|
} else {
|
|
pass "Correct hash list in TPI stream."
|
|
}
|
|
|
|
# check skip list
|
|
|
|
set fi [open tmpdir/pdb-types1-skiplist w]
|
|
fconfigure $fi -translation binary
|
|
puts -nonewline $fi $skip_list
|
|
close $fi
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb-types1-skiplist.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types1-skiplist"]
|
|
if ![string match $exp $got] {
|
|
fail "Incorrect skip list in TPI stream."
|
|
} else {
|
|
pass "Correct skip list in TPI stream."
|
|
}
|
|
}
|
|
|
|
proc test6 { } {
|
|
global as
|
|
global ar
|
|
global ld
|
|
global objdump
|
|
global srcdir
|
|
global subdir
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb-types2a.s tmpdir/pdb-types2a.o] {
|
|
unsupported "Build pdb-types2a.o"
|
|
return
|
|
}
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb-types2b.s tmpdir/pdb-types2b.o] {
|
|
unsupported "Build pdb-types2b.o"
|
|
return
|
|
}
|
|
|
|
if ![ld_link $ld "tmpdir/pdb-types2.exe" "--pdb=tmpdir/pdb-types2.pdb tmpdir/pdb-types2a.o tmpdir/pdb-types2b.o"] {
|
|
unsupported "Create PE image with PDB file"
|
|
return
|
|
}
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types2.pdb 0004"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
fail "Could not extract IPI stream"
|
|
return
|
|
} else {
|
|
pass "Extracted IPI stream"
|
|
}
|
|
|
|
# check values in IPI header, and save anything interesting
|
|
|
|
set fi [open tmpdir/0004]
|
|
fconfigure $fi -translation binary
|
|
|
|
seek $fi 8 current
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i first_type
|
|
|
|
if { $first_type != 0x1000 } {
|
|
fail "Incorrect first type value in IPI stream."
|
|
} else {
|
|
pass "Correct first type value in IPI stream."
|
|
}
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i end_type
|
|
|
|
# end_type is one greater than the last type in the stream
|
|
if { $end_type != 0x100f } {
|
|
fail "Incorrect end type value in IPI stream."
|
|
} else {
|
|
pass "Correct end type value in IPI stream."
|
|
}
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i type_list_size
|
|
|
|
set data [read $fi 2]
|
|
binary scan $data s hash_stream_index
|
|
|
|
seek $fi 2 current
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i hash_size
|
|
|
|
if { $hash_size != 4 } {
|
|
fail "Incorrect hash size in IPI stream."
|
|
} else {
|
|
pass "Correct hash size in IPI stream."
|
|
}
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i num_buckets
|
|
|
|
if { $num_buckets != 0x3ffff } {
|
|
fail "Incorrect number of buckets in IPI stream."
|
|
} else {
|
|
pass "Correct number of buckets in IPI stream."
|
|
}
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i hash_list_offset
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i hash_list_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i skip_list_offset
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i skip_list_size
|
|
|
|
seek $fi 8 current
|
|
|
|
set type_list [read $fi $type_list_size]
|
|
|
|
close $fi
|
|
|
|
set fi [open tmpdir/pdb-types2-typelist w]
|
|
fconfigure $fi -translation binary
|
|
puts -nonewline $fi $type_list
|
|
close $fi
|
|
|
|
# check type list
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb-types2-typelist.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types2-typelist"]
|
|
if ![string match $exp $got] {
|
|
fail "Incorrect type list in IPI stream."
|
|
} else {
|
|
pass "Correct type list in IPI stream."
|
|
}
|
|
|
|
# extract hash list and skip list
|
|
|
|
set index_str [format "%04x" $hash_stream_index]
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types2.pdb $index_str"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
fail "Could not extract IPI hash stream."
|
|
} else {
|
|
pass "Extracted IPI hash stream."
|
|
}
|
|
|
|
set fi [open tmpdir/$index_str]
|
|
fconfigure $fi -translation binary
|
|
|
|
seek $fi $hash_list_offset
|
|
set hash_list [read $fi $hash_list_size]
|
|
|
|
seek $fi $skip_list_offset
|
|
set skip_list [read $fi $skip_list_size]
|
|
|
|
close $fi
|
|
|
|
# check hash list
|
|
|
|
set fi [open tmpdir/pdb-types2-hashlist w]
|
|
fconfigure $fi -translation binary
|
|
puts -nonewline $fi $hash_list
|
|
close $fi
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb-types2-hashlist.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types2-hashlist"]
|
|
if ![string match $exp $got] {
|
|
fail "Incorrect hash list in IPI stream."
|
|
} else {
|
|
pass "Correct hash list in IPI stream."
|
|
}
|
|
|
|
# check skip list
|
|
|
|
set fi [open tmpdir/pdb-types2-skiplist w]
|
|
fconfigure $fi -translation binary
|
|
puts -nonewline $fi $skip_list
|
|
close $fi
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb-types2-skiplist.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types2-skiplist"]
|
|
if ![string match $exp $got] {
|
|
fail "Incorrect skip list in IPI stream."
|
|
} else {
|
|
pass "Correct skip list in IPI stream."
|
|
}
|
|
}
|
|
|
|
proc test7 { } {
|
|
global as
|
|
global ar
|
|
global ld
|
|
global objdump
|
|
global srcdir
|
|
global subdir
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb-types3a.s tmpdir/pdb-types3a.o] {
|
|
unsupported "Build pdb-types3a.o"
|
|
return
|
|
}
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb-types3b.s tmpdir/pdb-types3b.o] {
|
|
unsupported "Build pdb-types3b.o"
|
|
return
|
|
}
|
|
|
|
if ![ld_link $ld "tmpdir/pdb-types3.exe" "--pdb=tmpdir/pdb-types3.pdb tmpdir/pdb-types3a.o tmpdir/pdb-types3b.o"] {
|
|
unsupported "Create PE image with PDB file"
|
|
return
|
|
}
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types3.pdb 0004"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
fail "Could not extract IPI stream"
|
|
return
|
|
} else {
|
|
pass "Extracted IPI stream"
|
|
}
|
|
|
|
set fi [open tmpdir/0004]
|
|
fconfigure $fi -translation binary
|
|
|
|
seek $fi 16 current
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i type_list_size
|
|
|
|
set data [read $fi 2]
|
|
binary scan $data s hash_stream_index
|
|
|
|
seek $fi 10 current
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i hash_list_offset
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i hash_list_size
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i skip_list_offset
|
|
|
|
set data [read $fi 4]
|
|
binary scan $data i skip_list_size
|
|
|
|
seek $fi 8 current
|
|
|
|
set type_list [read $fi $type_list_size]
|
|
|
|
close $fi
|
|
|
|
set fi [open tmpdir/pdb-types3-typelist w]
|
|
fconfigure $fi -translation binary
|
|
puts -nonewline $fi $type_list
|
|
close $fi
|
|
|
|
# check type list
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb-types3-typelist.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types3-typelist"]
|
|
if ![string match $exp $got] {
|
|
fail "Incorrect type list in IPI stream."
|
|
} else {
|
|
pass "Correct type list in IPI stream."
|
|
}
|
|
|
|
# extract hash list and skip list
|
|
|
|
set index_str [format "%04x" $hash_stream_index]
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-types3.pdb $index_str"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
fail "Could not extract IPI hash stream."
|
|
} else {
|
|
pass "Extracted IPI hash stream."
|
|
}
|
|
|
|
set fi [open tmpdir/$index_str]
|
|
fconfigure $fi -translation binary
|
|
|
|
seek $fi $hash_list_offset
|
|
set hash_list [read $fi $hash_list_size]
|
|
|
|
seek $fi $skip_list_offset
|
|
set skip_list [read $fi $skip_list_size]
|
|
|
|
close $fi
|
|
|
|
# check hash list
|
|
|
|
set fi [open tmpdir/pdb-types3-hashlist w]
|
|
fconfigure $fi -translation binary
|
|
puts -nonewline $fi $hash_list
|
|
close $fi
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb-types3-hashlist.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types3-hashlist"]
|
|
if ![string match $exp $got] {
|
|
fail "Incorrect hash list in IPI stream."
|
|
} else {
|
|
pass "Correct hash list in IPI stream."
|
|
}
|
|
|
|
# check skip list
|
|
|
|
set fi [open tmpdir/pdb-types3-skiplist w]
|
|
fconfigure $fi -translation binary
|
|
puts -nonewline $fi $skip_list
|
|
close $fi
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb-types3-skiplist.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/pdb-types3-skiplist"]
|
|
if ![string match $exp $got] {
|
|
fail "Incorrect skip list in IPI stream."
|
|
} else {
|
|
pass "Correct skip list in IPI stream."
|
|
}
|
|
}
|
|
|
|
proc test8 { } {
|
|
global as
|
|
global ar
|
|
global ld
|
|
global objdump
|
|
global srcdir
|
|
global subdir
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb-syms1a.s tmpdir/pdb-syms1a.o] {
|
|
unsupported "Build pdb-syms1a.o"
|
|
return
|
|
}
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb-syms1b.s tmpdir/pdb-syms1b.o] {
|
|
unsupported "Build pdb-syms1b.o"
|
|
return
|
|
}
|
|
|
|
if ![ld_link $ld "tmpdir/pdb-syms1.exe" "--pdb=tmpdir/pdb-syms1.pdb tmpdir/pdb-syms1a.o tmpdir/pdb-syms1b.o"] {
|
|
unsupported "Create PE image with PDB file"
|
|
return
|
|
}
|
|
|
|
# get index of globals stream and records stream
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms1.pdb 0003"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
fail "Could not extract DBI stream"
|
|
return
|
|
} else {
|
|
pass "Extracted DBI stream"
|
|
}
|
|
|
|
set fi [open tmpdir/0003]
|
|
fconfigure $fi -translation binary
|
|
|
|
seek $fi 12
|
|
set data [read $fi 2]
|
|
binary scan $data s globals_index
|
|
|
|
seek $fi 6 current
|
|
set data [read $fi 2]
|
|
binary scan $data s records_index
|
|
|
|
seek $fi 2 current
|
|
set data [read $fi 4]
|
|
binary scan $data i mod_info_size
|
|
|
|
seek $fi 36 current
|
|
set mod_info [read $fi $mod_info_size]
|
|
|
|
close $fi
|
|
|
|
# get index of first and second module streams
|
|
|
|
binary scan [string range $mod_info 34 35] s mod1_index
|
|
|
|
set off 64
|
|
|
|
set obj1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]]
|
|
incr off [expr [string length $obj1] + 1]
|
|
|
|
set ar1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]]
|
|
incr off [expr [string length $ar1] + 1]
|
|
|
|
if { [expr $off % 4] != 0 } {
|
|
set off [expr $off + 4 - ($off % 4)]
|
|
}
|
|
|
|
incr off 34
|
|
|
|
binary scan [string range $mod_info $off [expr $off + 1]] s mod2_index
|
|
|
|
# check globals stream
|
|
|
|
set index_str [format "%04x" $globals_index]
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms1.pdb $index_str"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
fail "Could not extract globals stream"
|
|
return
|
|
} else {
|
|
pass "Extracted globals stream"
|
|
}
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb-syms1-globals.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
|
|
|
|
if [string match $exp $got] {
|
|
pass "Correct globals stream"
|
|
} else {
|
|
fail "Incorrect globals stream"
|
|
}
|
|
|
|
# check records stream
|
|
|
|
set index_str [format "%04x" $records_index]
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms1.pdb $index_str"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
fail "Could not extract records stream"
|
|
return
|
|
} else {
|
|
pass "Extracted records stream"
|
|
}
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb-syms1-records.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
|
|
|
|
if [string match $exp $got] {
|
|
pass "Correct records stream"
|
|
} else {
|
|
fail "Incorrect records stream"
|
|
}
|
|
|
|
# check symbols in first module
|
|
|
|
set index_str [format "%04x" $mod1_index]
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms1.pdb $index_str"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
fail "Could not extract first module's symbols"
|
|
return
|
|
} else {
|
|
pass "Extracted first module's symbols"
|
|
}
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb-syms1-symbols1.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
|
|
|
|
if [string match $exp $got] {
|
|
pass "Correct symbols in first module's stream"
|
|
} else {
|
|
fail "Incorrect symbols in first module's stream"
|
|
}
|
|
|
|
# check symbols in second module
|
|
|
|
set index_str [format "%04x" $mod2_index]
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms1.pdb $index_str"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
fail "Could not extract second module's symbols"
|
|
return
|
|
} else {
|
|
pass "Extracted second module's symbols"
|
|
}
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb-syms1-symbols2.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
|
|
|
|
if [string match $exp $got] {
|
|
pass "Correct symbols in second module's stream"
|
|
} else {
|
|
fail "Incorrect symbols in second module's stream"
|
|
}
|
|
}
|
|
|
|
proc test9 { } {
|
|
global as
|
|
global ar
|
|
global ld
|
|
global objdump
|
|
global srcdir
|
|
global subdir
|
|
|
|
if ![ld_assemble $as $srcdir/$subdir/pdb-syms2.s tmpdir/pdb-syms2.o] {
|
|
unsupported "Build pdb-syms2.o"
|
|
return
|
|
}
|
|
|
|
if ![ld_link $ld "tmpdir/pdb-syms2.exe" "--pdb=tmpdir/pdb-syms2.pdb tmpdir/pdb-syms2.o"] {
|
|
unsupported "Create PE image with PDB file"
|
|
return
|
|
}
|
|
|
|
# get index of module stream
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms2.pdb 0003"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
fail "Could not extract DBI stream"
|
|
return
|
|
} else {
|
|
pass "Extracted DBI stream"
|
|
}
|
|
|
|
set fi [open tmpdir/0003]
|
|
fconfigure $fi -translation binary
|
|
|
|
seek $fi 24
|
|
set data [read $fi 4]
|
|
binary scan $data i mod_info_size
|
|
|
|
seek $fi 36 current
|
|
set mod_info [read $fi $mod_info_size]
|
|
|
|
close $fi
|
|
|
|
binary scan [string range $mod_info 34 35] s module_index
|
|
|
|
# check module records
|
|
|
|
set index_str [format "%04x" $module_index]
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms2.pdb $index_str"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
fail "Could not extract module symbols"
|
|
return
|
|
} else {
|
|
pass "Extracted module symbols"
|
|
}
|
|
|
|
set exp [file_contents "$srcdir/$subdir/pdb-syms2-symbols1.d"]
|
|
set got [run_host_cmd "$objdump" "-s --target=binary tmpdir/$index_str"]
|
|
|
|
if [string match $exp $got] {
|
|
pass "Correct symbols in module stream"
|
|
} else {
|
|
fail "Incorrect symbols in module stream"
|
|
}
|
|
|
|
# check linker symbols
|
|
|
|
set off 64
|
|
|
|
set obj1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]]
|
|
incr off [expr [string length $obj1] + 1]
|
|
|
|
set ar1 [string range $mod_info $off [expr [string first \000 $mod_info $off] - 1]]
|
|
incr off [expr [string length $ar1] + 1]
|
|
|
|
if { [expr $off % 4] != 0 } {
|
|
set off [expr $off + 4 - ($off % 4)]
|
|
}
|
|
|
|
incr off 34
|
|
|
|
binary scan [string range $mod_info $off [expr $off + 1]] s linker_syms_index
|
|
|
|
set index_str [format "%04x" $linker_syms_index]
|
|
|
|
set exec_output [run_host_cmd "$ar" "x --output tmpdir tmpdir/pdb-syms2.pdb $index_str"]
|
|
|
|
if ![string match "" $exec_output] {
|
|
fail "Could not extract linker symbols"
|
|
return
|
|
} else {
|
|
pass "Extracted linker symbols"
|
|
}
|
|
|
|
set syms [file_contents "tmpdir/$index_str"]
|
|
|
|
# check S_OBJNAME
|
|
|
|
set off 4
|
|
binary scan [string range $syms $off [expr $off + 1]] s sym_len
|
|
binary scan [string range $syms [expr $off + 2] [expr $off + 3]] s sym_type
|
|
|
|
if { $sym_type != 0x1101 } {
|
|
fail "First linker symbol was not S_OBJNAME"
|
|
} else {
|
|
pass "First linker symbol was S_OBJNAME"
|
|
|
|
set linker_fn [string range $syms [expr $off + 8] [expr [string first \000 $syms [expr $off + 8]] - 1]]
|
|
|
|
if ![string equal $linker_fn "* Linker *"] {
|
|
fail "Incorrect linker object name"
|
|
} else {
|
|
pass "Correct linker object name"
|
|
}
|
|
}
|
|
|
|
incr off [expr $sym_len + 2]
|
|
|
|
# check S_COMPILE3
|
|
|
|
binary scan [string range $syms $off [expr $off + 1]] s sym_len
|
|
binary scan [string range $syms [expr $off + 2] [expr $off + 3]] s sym_type
|
|
|
|
if { $sym_type != 0x113c } {
|
|
fail "Second linker symbol was not S_COMPILE3"
|
|
} else {
|
|
pass "Second linker symbol was S_COMPILE3"
|
|
}
|
|
|
|
incr off [expr $sym_len + 2]
|
|
|
|
# check S_ENVBLOCK
|
|
|
|
binary scan [string range $syms $off [expr $off + 1]] s sym_len
|
|
binary scan [string range $syms [expr $off + 2] [expr $off + 3]] s sym_type
|
|
|
|
if { $sym_type != 0x113d } {
|
|
fail "Third linker symbol was not S_ENVBLOCK"
|
|
} else {
|
|
pass "Third linker symbol was S_ENVBLOCK"
|
|
}
|
|
}
|
|
|
|
test1
|
|
test2
|
|
test3
|
|
test4
|
|
test5
|
|
test6
|
|
test7
|
|
test8
|
|
test9
|