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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
#!/usr/bin/perl -w
use strict;
# Analyse beam_emu.s and try to find out the registers
# used for the important variables in process_main().
#
# Works for .s files from clang or gcc. For gcc, the -fverbose-asm
# option must be used.
#
# Example:
#
# $ beam-emu-vars -vars 'c_p E HTOP FCALLS I reg freg' beam_emu.s
# E: %r13
# FCALLS: %rcx:98 %rax:88 16(%rsp):50 %rdi:6
# HTOP: %r10:382 64(%rsp):88 72(%rsp):9 24(%rsp):7 %rcx:6 %r15:6 80(%rsp):3 88(%rsp):2
# I: %rbx
# c_p: %rbp
# freg: 48(%rsp):11 %rcx:8 %rdi:5 %rax:4
# reg: %r12
#
# That means that E, I, c_p, reg seems to be assigned to permanent registers.
# HTOP seems to be assigned %r10, but it is saved to a scratch location
# before any function calls. FCALLS and freg seems to be saved in a location on
# the stack and loaded into a register when used.
#
# The exit status will be 0 if all variables are assigned to registers (most of
# the time), and 1 if one or more variables are assigned to a stack location.
my $vars = 'c_p E FCALLS freg HTOP I reg';
while (@ARGV and $ARGV[0] =~ /^-(.*)/) {
$_ = $1;
shift;
($vars = shift), next if /^vars/;
die "$0: Bad option: -$_\n";
}
my @vars = split(" ", $vars);
my %vars;
@vars{@vars} = @vars;
my $inside;
my %count;
if (@ARGV != 1) {
usage();
}
while (<>) {
if (!$inside && /[.]globl\s*_?process_main/) {
$inside = 1;
} elsif ($inside && /[.]globl/) {
last;
}
if ($inside) {
if (/##DEBUG_VALUE:\s*process_main:([A-Za-z]*)\s*<-\s*(.*)/) {
# clang
my($var,$reg) = ($1,$2);
next if $reg =~ /^[-\d]+$/; # Ignore if number.
$count{$var}->{$reg}++ if $vars{$var};
next;
}
# Parse gcc verbose arguments. Comments are marked with
# one '#' (clang marks its comments with two '#').
my($src,$dst,$comment) = /movq\s+([^#]+), ([^#]+)#(?!#)\s*(.*)/;
next unless $comment;
$dst =~ s/\s*$//;
my($vsrc,$vdst) = split /,/, $comment, 2;
$vdst =~ s/^\s//;
update_count(\%count, $vsrc, $src);
update_count(\%count, $vdst, $dst);
if ($vars{$vdst} and $vsrc eq '%sfp') {
$count{$vdst}->{$src}++;
}
}
}
my @first;
OUTER:
for my $var (sort keys %count) {
my $total = 0;
foreach my $reg (keys %{$count{$var}}) {
$total += $count{$var}->{$reg}++;
}
foreach my $reg (keys %{$count{$var}}) {
if ($count{$var}->{$reg} > 0.9*$total) {
print "$var: $reg\n";
push @first, $var;
next OUTER;
}
}
my @r;
foreach my $reg (keys %{$count{$var}}) {
push @r, $reg;
}
@r = sort { $count{$var}->{$b} <=> $count{$var}->{$a} } @r;
@r = map { "$_:$count{$var}->{$_}" } @r;
push @first, $r[0];
print "$var: ", join(' ', @r), "\n";
}
foreach (@first) {
exit 1 if /%rsp/;
}
exit 0;
sub update_count {
my($count_ref,$var,$reg) = @_;
return unless $vars{$var};
${${$count_ref}{$var}}{$reg}++;
}
sub usage {
die qq[usage: beam_emu_vars [ -vars "var1 var2..." ] <filename>.s\n\n] .
"The exit status is 0 if all variables are assigned to registers,\n" .
"and 1 if one or more variables are allocated to a stack location.\n";
}
|
