-
Notifications
You must be signed in to change notification settings - Fork 135
/
tracer.nqp
126 lines (97 loc) · 3.41 KB
/
tracer.nqp
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
123
124
125
126
# Copyright (C) 2010, Parrot Foundation.
# $Id$
=begin
=head1 NAME
examples/library/tracer.nqp - Implementation of the tracing runcore using the Instrument dynpmc
=head1 DESCRIPTION
A simple example of how to use the Instrument dynpmc in nqp.
=head1 SYNOPSIS
% ./parrot-nqp examples/library/tracer.nqp <file>
=cut
=end
Q:PIR {
load_bytecode 'Instrument/InstrumentLib.pbc'
};
my $args := pir::getinterp__p()[2];
$args.shift();
my $probe := Instrument::Probe.new();
$probe.catchall(1);
$probe.callback('tracer');
my $instr := Q:PIR { %r = new ['Instrument'] };
$instr.attach($probe);
$instr.run($args[0], $args);
sub tracer ($op, $instr_obj, $probe) {
my $sprintf_args := [$op.pc()];
my $pc_hex := pir::sprintf__SSP("%04x", $sprintf_args);
my $op_name := $op.family();
my $param_cnt := $op.count();
my $params := '';
my $cur_arg := 0;
my $arg_list := [];
while $cur_arg < $param_cnt {
my $arg_str;
my $arg_type := $op.arg_type($cur_arg);
my $arg := $op.get_arg($cur_arg, 1);
# Evaluate in order of:
# 1. keys
# 2. constants
# 3. regs.
# TODO: There's probably a smarter way to do the code below. Messy!
if pir::band__III($arg_type, 0x20) == 0x20 {
# Keys.
if pir::band__III($arg_type, 16) == 16 {
# Constant keys are int constants or strings.
if pir::band__III($arg_type, 2) == 2 {
# String constant key.
my $arg_val := pir::escape__SS($op.get_arg($cur_arg));
$arg_str := '["' ~ $arg_val ~ '"]';
} else {
# Integer constant key.
$arg_str := '[' ~ $arg ~ ']';
}
} else {
# Non-constant keys. Reference regs only.
if !$arg_type {
# 0 is int reg.
$arg_str := '[I' ~ $arg ~ ']';
} elsif pir::band__III($arg_type, 2) == 2 {
# 2 is pmc.
$arg_str := '[P' ~ $arg ~ ']';
}
}
my $prev := $arg_list.pop();
$arg_str := $prev ~ $arg_str;
} elsif pir::band__III($arg_type, 16) == 16
&& pir::band__III($arg_type, 2) != 2 {
if pir::band__III($arg_type, 1) == 1 {
my $arg_val := pir::escape__SS($op.get_arg($cur_arg));
$arg_str := '"' ~ $arg_val ~ '"';
} else {
$arg_str := $arg;
}
} elsif !$arg_type {
# 0 is int reg.
$arg_str := 'I' ~ $arg;
} elsif pir::band__III($arg_type, 1) == 1{
# 1 is string reg.
$arg_str := 'S' ~ $arg;
} elsif pir::band__III($arg_type, 2) == 2 {
# 2 is pmc.
if pir::band__III($arg_type, 16) == 16 {
# Constant pmc.
$arg_str := 'PC' ~ $arg;
} else {
# Normal reg.
$arg_str := 'P' ~ $arg;
}
} elsif pir::band__III($arg_type, 3) == 3 {
# 3 is num reg.
$arg_str := 'N' ~ $arg;
}
$arg_list.push($arg_str);
$cur_arg++;
}
$params := pir::join__SSP(', ', $arg_list);
say($pc_hex ~ ' ' ~ $op_name ~ ' ' ~ $params);
};
# vim: ft=perl6 expandtab shiftwidth=4: