File: clean-stack-filter

package info (click to toggle)
simgrid 3.21%2Bdfsg-4
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 21,972 kB
  • sloc: cpp: 88,193; ansic: 69,244; fortran: 6,089; f90: 5,162; xml: 4,861; java: 4,250; perl: 2,056; python: 1,193; sh: 1,159; makefile: 57; sed: 6
file content (70 lines) | stat: -rwxr-xr-x 1,724 bytes parent folder | download | duplicates (4)
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
#!/usr/bin/env perl
# Transform assembly in order to clean each stack frame for X86_64.

use strict;
use warnings;

$SIG{__WARN__} = sub { die @_ };

# Whether we are still scanning the content of a function:
our $scanproc = 0;

# Save lines of the function:
our $lines = "";

# Size of the stack for this function:
our $size = 0;

# Counter for assigning unique ids to labels:
our $id=0;

sub emit_code {
    my $qsize = $size / 8;
    my $offset = - $size - 8;

    if($size != 0) {
      # This is a crude hack to disable the stack cleaning on the main
      # stack.  It relies on the fact that the main stack is high in
      # the address space and the other stacks are in the heap (lower).
      print("\tmovq \$0x7fff00000000, %r11\n");
      print("\tcmpq %r11, %rsp\n");
      print("\tjae .Lstack_cleaner_done$id\n");

      # Loop over the stack frame quadwords and zero it:
      print("\tmovabsq \$$qsize, %r11\n");
      print(".Lstack_cleaner_loop$id:\n");
      print("\tmovq    \$0, $offset(%rsp,%r11,8)\n");
      print("\tsubq    \$1, %r11\n");
      print("\tjne     .Lstack_cleaner_loop$id\n");
      print(".Lstack_cleaner_done$id:\n");
    }

    print $lines;

    $id = $id + 1;
    $size = 0;
    $lines = "";
    $scanproc = 0;
}

while (<>) {
  if ($scanproc) {
      $lines = $lines . $_;
      if (m/^[ \t]*.cfi_endproc$/) {
        emit_code();
      } elsif (m/^[ \t]*pushq/) {
         $size += 8;
      } elsif (m/^[ \t]*subq[\t *]\$([0-9]*),[ \t]*%rsp$/) {
         my $val = $1;
         $val = oct($val) if $val =~ /^0/;
         $size += $val;
         emit_code();
      }
  } elsif (m/^[ \t]*.cfi_startproc$/) {
      print $_;

      $scanproc = 1;
  } else {
      print $_;
  }
}