103 lines
2.0 KiB
Tcl
103 lines
2.0 KiB
Tcl
#!/usr/bin/tclsh
|
|
#########################################################################################
|
|
# Parse output from ld_classic that complains about missing symbols and look them
|
|
# up in the named object file
|
|
#
|
|
|
|
proc parse_line {line} {
|
|
|
|
global last_fname
|
|
|
|
set toks [split $line]
|
|
if { ![regexp "ld_classic:" [lindex $toks 0]] } {
|
|
puts "ignoring garbage '$line'"
|
|
return
|
|
}
|
|
|
|
set fname [lindex $toks 1]
|
|
set relent [lindex $toks 7]
|
|
set sect [lindex $toks 10]
|
|
|
|
# strip archive member name if present
|
|
set ppos [string last "(" $fname];
|
|
if {$ppos != -1} {
|
|
set fname [string range $fname 0 [expr $ppos - 1]];
|
|
}
|
|
|
|
#puts "% $fname % $relent % $sect"
|
|
|
|
set relname [find_sym $fname $relent $sect]
|
|
|
|
if {$last_fname != $fname} {
|
|
puts "$fname:"
|
|
set last_fname $fname
|
|
}
|
|
|
|
puts " $relname"
|
|
}
|
|
|
|
proc find_sym {fname relent sect} {
|
|
|
|
global reloc_$fname
|
|
|
|
if {![array exists reloc_$fname]} {
|
|
get_relocs $fname
|
|
}
|
|
upvar 0 reloc_$fname relocs
|
|
if {[array names relocs -exact $sect:$relent] == ""} {
|
|
puts "Don't know reloc $relent for $fname"
|
|
exit 1
|
|
}
|
|
return $relocs($sect:$relent)
|
|
}
|
|
|
|
proc get_relocs {fname} {
|
|
|
|
global reloc_$fname
|
|
upvar 0 reloc_$fname relocs
|
|
|
|
set body [exec otool -rv $fname]
|
|
set lines [split $body "\n"]
|
|
|
|
set curr_sect "none"
|
|
|
|
foreach line $lines {
|
|
|
|
set toks [split [collapse $line]]
|
|
|
|
if {[lindex $toks 0] == "Relocation"} {
|
|
set sect [lindex $toks 2]
|
|
set count [lindex $toks 3]
|
|
set curr_sect $sect
|
|
set counter 0
|
|
continue
|
|
}
|
|
|
|
if {[string is xdigit [lindex $toks 0]]} {
|
|
if {[llength $toks] == 7} {
|
|
set relocs($curr_sect:$counter) [lindex $toks 6]
|
|
}
|
|
incr counter
|
|
}
|
|
}
|
|
}
|
|
|
|
proc collapse {str} {
|
|
|
|
set before ""
|
|
set after $str
|
|
|
|
while {$before != $after} {
|
|
set before $after
|
|
|
|
set after [string map [list " " " "] $before]
|
|
}
|
|
return $after
|
|
}
|
|
|
|
# Suck from standard input
|
|
set last_fname ""
|
|
while {[gets stdin line] > 0} {
|
|
parse_line $line
|
|
}
|