summaryrefslogtreecommitdiff
path: root/scripts/conncmp.pl
blob: 7de7db2eb76459d1fe81b19073b46cf4edfd1f38 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
#!/usr/bin/perl
#
# conncmp.pl - Compare signal names on connectors
#

sub usage
{
	print STDERR <<"EOF";
usage: $0 list-a.net comp-a list-b.net comp-b pat-a=pat-b ...

  patterns can be constant, e.g., GND=GND3
  or variable, e.g., %=%_U
  Nets connecting to no other component are renamed to NC.
EOF
	exit(1);
}


sub get_pins
{
	local ($file, $comp) = @_;

	my %pins = ();
	my $net = undef;
	my $single = undef;
	my $conns = 0;

	open(FILE, $file) || die "$file: $!";
	while (<FILE>) {
		if (/\(net\s+.*\(name\s+"([^"]+)"\)/ ||
		    /\(net\s+.*\(name\s+(\S+?)\)/) {
			$pins{$single} = "NC" if $conns == 1;
			$net = $1;
			$net =~ s#^/.*/##;
			$single = undef;
			$conns = 0;
			next;
		}
		next unless /\(node\s+\(ref\s+(\S+?)\)\s+\(pin\s+(\S+?)\)/;

		$conns++;
		next unless $1 eq $comp;
		die "duplicate pin $1.$2" if defined $pins{$2};
		die "undefined net" unless defined $net;
		$pins{$2} = $net;
		$single = $2;
	}
	close(FILE);
	return \%pins;
}


&usage unless $#ARGV >= 3;
%a = %{ &get_pins($ARGV[0], $ARGV[1]) };
%b = %{ &get_pins($ARGV[2], $ARGV[3]) };
@eq = @ARGV[4 .. $#ARGV];

for (@eq) {
	&usage unless $_ =~ /=/;
}

PIN: for $pin (keys %a) {
	if (!defined $b{$pin}) {
		warn "A.$pin has no matching B.$pin\n";
		next;
	}
	my $a = $a{$pin};
	my $b = $b{$pin};
	delete $b{$pin};
	next if $a eq $b;
	for (@eq) {
		die unless /=/;
		my ($pa, $pb) = ($`, $');
		if ($pa =~ /%/) {
			my $pat = "^$`(.*)$'\$";
			next unless $a =~ $pat;
			my $var = $1;
			$pb =~ s/%/$var/g;
			next PIN if $b eq $pb;
		} else {
			next PIN if $a eq $pa && $b eq $pb;
		}
	}
	die "A.$pin($a) does not seem to match B.$pin($b)\n";
}

for $pin (keys %b) {
	warn "B.$pin has no matching A.$pin\n";
}