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
|
my $text = slurp();
my $comments = $text.match(:g, / '/*' .*? '*/' /);
my %alloctypemap = <
m MVM_malloc_array
c MVM_calloc_array
>;
my @substitutions;
for $text.split(";") {
my $line = $_.trim-leading;
sub skip-because($reason) {
#note "skipped command $line.substr(0, 3) because $reason";
next;
}
next unless $line.chars;
next if $line eq '}';
skip-because("preprocessor stuff") if .starts-with("#");
skip-because("no MVM and no alloc") unless .contains("alloc") && .contains("MVM_");
skip-because("no MVM_.?alloc") unless / MVM_[m|c|re|rec]alloc /;
skip-because("array of pointers") if .contains('**)') || .contains('** )');
my regex formula {
| <ident>? '(' <-[\)]>+ ')'
| \S+
}
#/ :s <?> \( $<type>=[<ident>] '*' \) (MVM_[m|c]alloc) \( <formula> '*' 'sizeof' '(' $<type>=[ 'MVM' <-[\s]>+ & <ident> ] ')' /;
/ [\( $<casttype>=[<ident>] \s* '*' \) \s*]? (MVM_(m|c)alloc) \s* \( [<formula> \s* ['*' | ',']]? \s* 'sizeof' \s* \( \s* $<type>=<ident> \s* \) \) /;
unless $/ {
say "REJECTED";
.say;
}
next unless $/;
#.say;
say "original: $/.Str()";
my $formula = $<formula>.Str;
$formula .= substr(1, *-1) if $formula.chars && $formula.starts-with("(") and $formula.ends-with(")");
$formula ~= ", " if $formula.chars;
$formula ||= "1, ";
say "";
say " ", my $result = "%alloctypemap{$0[0]}\($formula$<type>\)";
say "";
@substitutions.push([$/.Str, $result]);
}
for @substitutions {
$text .= subst(.[0], .[1]);
}
spurt(@*ARGS[0], $text);
|
