#!/usr/bin/tclsh

#
# \brief  Detect inconsistencies between a shared library and its ABI
# \author Norman Feske
# \date   2018-01-10
#
# The tool takes a shared library and an ABI-symbols file as arguments.
# It checks for violations of the ABI by the shared library. Additionally,
# it examines the ABI-symbols file for unexpected content such as duplicated
# symbols or trailing whitespace.
#

# normalize sort order across platforms
set env(LC_ALL) C

set lib_path [lindex $argv 0]
set abi_path [lindex $argv 1]

#
# Obtain symbol information for the shared library via 'nm'
#
# The redirection of stderr to /dev/null is solely needed to prevent tclsh from
# creating a temporary file at /tmp/tcl_XXXX and relying on POSIX's late unlink
# mechanism. The latter is not available when executing the tool chain on
# Genode.
#
set lib_content [split [exec nm --format posix --dynamic $lib_path 2> /dev/null | sort] "\n"]
set abi_content [split [exec cat $abi_path 2> /dev/null] "\n"]

set abi_name [lindex [file split $abi_path] end]
set num_errors 0

proc report_error { message } {
	global num_errors
	puts stderr "Error: $message"
	incr num_errors
}


#
# Warn about an ABI symbol definition that was generated by the 'abi_symbols'
# tool but hasn't undergone any manual review. This is most likely an
# accidental omission.
#
foreach line $abi_content {
	if {$line == "# Please review the symbols and remove this line."} {
		report_error "attempt to use unreviewed $abi_name ABI\n       at $abi_path" } }


#
# Extract symbol list w/o comments and empty lines, check for trailing spaces
#

proc line_contains_symbol { line } {
	if {$line == ""}         { return 0 }
	if {[regexp {^#} $line]} { return 0 }
	return 1
}

set abi_symbols ""
set num_lines 0
foreach line $abi_content {
	if {[line_contains_symbol $line]} {
		lappend abi_symbols $line }

	if {[regexp {\s+$} $line]} {
		report_error "trailing whitespace at $abi_path line $num_lines" }

	incr num_lines
}


#
# Check for absence of Genode-internal linking artifacts from ABI
#
# The listed symbols may appear in shared objects but should not by part
# of any ABI.
#
set fd [open "[file dirname $argv0]/internal_abi.list"]
set symbol_blacklist [split [read $fd] "\n"]
close $fd

foreach line $abi_symbols {
	set name [lindex $line 0]
	foreach blacklisted_symbol $symbol_blacklist {
		if {$name == $blacklisted_symbol} {
			report_error "$abi_name ABI contains Genode-internal symbol '$name'"
		}
	}
}


#
# Check for duplicates in the ABI
#

proc abi_symbol_name { line } { return [lindex $line 0] }

foreach line $abi_symbols { set  count([abi_symbol_name $line]) 0 }
foreach line $abi_symbols { incr count([abi_symbol_name $line]) }

set duplicates {}

foreach line $abi_symbols {
	if {$count([abi_symbol_name $line]) > 1} {
		lappend duplicates [abi_symbol_name $line] } }

# sort the list to report each duplicate only once
foreach name [lsort -unique $duplicates] {
	report_error "$abi_name ABI contains duplicate symbol '$name'" }


#
# Validate that library symbol sizes do not exceed their ABI symbol sizes
#

proc abi_symbol_has_size { line } { return [expr [llength $line] == 3] }

# determine decimal symbol size of library symbols
foreach lib_line $lib_content {
	if {[regexp {^([\w.]+) (\w) \w+ ?(\w*)$} $lib_line dummy name type size_hex]} {
		set lib_symbol_size($name) [expr 0x0$size_hex]
	}
}

foreach abi_line $abi_symbols {

	if {![abi_symbol_has_size $abi_line]} {
		continue }

	set name [lindex $abi_line 0]

	if {![info exists lib_symbol_size($name)]} {
		continue }

	set abi_symbol_size [lindex $abi_line end]

	if {$lib_symbol_size($name) > $abi_symbol_size} {
		set    message "size of '$name' symbol violates $abi_name ABI "
		append message "($abi_symbol_size bytes in ABI, $lib_symbol_size($name) bytes in library)"
		report_error $message
	}
}


if {$num_errors > 0} { exit -1 }