[svn:parrot] r47197 - branches/gsoc_instrument/examples/library
khairul at svn.parrot.org
khairul at svn.parrot.org
Mon May 31 08:19:31 UTC 2010
Author: khairul
Date: Mon May 31 08:19:31 2010
New Revision: 47197
URL: https://trac.parrot.org/parrot/changeset/47197
Log:
Rewrote tracer.pir in nqp and removed older pir example.
Added:
branches/gsoc_instrument/examples/library/tracer.nqp
Deleted:
branches/gsoc_instrument/examples/library/tracer.pir
Added: branches/gsoc_instrument/examples/library/tracer.nqp
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gsoc_instrument/examples/library/tracer.nqp Mon May 31 08:19:31 2010 (r47197)
@@ -0,0 +1,133 @@
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+=begin
+=head1 NAME
+
+examples/library/tracer.nqp - Implementation of the tracing runcore using the Instrument dynpmc
+
+=head1 SYNOPSIS
+
+ % ./parrot-nqp examples/library/tracer.nqp <file>
+
+=head1 DESCRIPTION
+
+A simple example of how to use the Instrument dynpmc in nqp.
+
+=end
+=cut
+
+Q:PIR {
+ load_bytecode 'Instrument/Instrument.pbc'
+ load_bytecode 'Instrument/Probe.pbc'
+};
+
+my $args := pir::getinterp__p()[2];
+$args.shift();
+
+my $probe := Instrument::Probe.new();
+$probe.make_catchall();
+$probe.set_callback('tracer');
+
+my $instr := Q:PIR { %r = new ['Instrument'] };
+$instr.attach($probe);
+$instr.run($args[0], $args);
+
+sub tracer ($pc, $op, $instr_obj) {
+ my $op_lib := Q:PIR { %r = new ['OpLib'] };
+ my $op_code := pir::set_p_p_ki__PPI($op_lib, $op[0]);
+ my $sprintf_args := [$pc];
+ my $pc_hex := pir::sprintf__SSP("%04x", $sprintf_args);
+ my $op_name := $op_code.family_name();
+ my $param_cnt := pir::elements($op_code);
+ my $params := '';
+ my $cur_arg := 0;
+
+ my $arg_list := [];
+ while $cur_arg < $param_cnt {
+ my $arg_str;
+ my $arg_type := pir::set_i_p_ki__IPI($op_code, $cur_arg);
+
+ # 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 := $instr_obj.get_op_arg($op[$cur_arg + 1], $arg_type);
+ # TODO: For pir code below, the above blows up. Figure out why.
+ # current workaround is to just print out the PMC constant value.
+ # $S0 = "test"
+ # $P1[$S0] = "sth"
+ $arg_str := '[' ~ 'PC' ~ $op[$cur_arg + 1] ~ ']';
+ } else {
+ # Integer constant key.
+ $arg_str := '[' ~ $op[$cur_arg + 1] ~ ']';
+ }
+ } else {
+ # Non-constant keys. Reference regs only.
+ if !$arg_type {
+ # 0 is int reg.
+ $arg_str := '[I' ~ $op[$cur_arg + 1] ~ ']';
+
+ } elsif pir::band__III($arg_type, 2) == 2 {
+ # 2 is pmc.
+ $arg_str := '[P' ~ $op[$cur_arg + 1] ~ ']';
+ }
+ }
+
+ 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 {
+ my $arg := $instr_obj.get_op_arg($op[$cur_arg + 1], $arg_type);
+
+ if pir::band__III($arg_type, 1) == 1 {
+ $arg_str := '"' ~ $arg ~ '"';
+ } else {
+ $arg_str := $arg;
+ }
+ } elsif !$arg_type {
+ # 0 is int reg.
+ $arg_str := 'I' ~ $op[$cur_arg + 1];
+
+ } elsif pir::band__III($arg_type, 1) == 1{
+ # 1 is string reg.
+ $arg_str := 'S' ~ $op[$cur_arg + 1];
+
+ } elsif pir::band__III($arg_type, 2) == 2 {
+ # 2 is pmc.
+ if pir::band__III($arg_type, 16) == 16 {
+ # Constant pmc.
+ $arg_str := 'PC' ~ $op[$cur_arg + 1];
+ } else {
+ # Normal reg.
+ $arg_str := 'P' ~ $op[$cur_arg + 1];
+ }
+
+ } elsif pir::band__III($arg_type, 3) == 3 {
+ # 3 is num reg.
+ $arg_str := 'N' ~ $op[$cur_arg + 1];
+
+ }
+
+ $arg_list.push($arg_str);
+ $cur_arg++;
+ }
+
+ my $prefix := ' ';
+ for $arg_list {
+ $params := $params ~ $prefix ~ $_;
+ $prefix := ', '
+ }
+
+ say($pc_hex ~ ' ' ~ $op_name ~ $params);
+};
+
+# vim: ft=perl6 expandtab shiftwidth=4:
Deleted: branches/gsoc_instrument/examples/library/tracer.pir
==============================================================================
--- branches/gsoc_instrument/examples/library/tracer.pir Mon May 31 08:19:31 2010 (r47196)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,143 +0,0 @@
-# Copyright (C) 2010, Parrot Foundation.
-# $Id$
-
-=head1 NAME
-
-examples/library/tracer.pir - A simple op tracing example for the Instrument dynpmc
-
-=head1 SYNOPSIS
-
- % ./parrot examples/library/tracer.pir <file>
-
-=head1 DESCRIPTION
-
-A simple example of how to use the Instrument dynpmc
-and associated libraries.
-
-=cut
-
-.sub '_init' :anon :load :init
- # Load the Instrument libraries.
- load_bytecode 'Instrument/Instrument.pbc'
- load_bytecode 'Instrument/Probe.pbc'
-.end
-
-.sub 'main' :main
- .param pmc args
- .local pmc instr, probe, probe2
- .local string me, file
-
- # Create a catchall probe which will be called for
- # each op.
- probe = new ['Instrument';'Probe']
- probe.'make_catchall'()
- probe.'set_callback'('catchall_callback')
- probe.'set_finalize'('catchall_finalize')
-
- # Create a probe that will be called whenever the
- # specified ops are encountered.
- probe2 = new ['Instrument';'Probe']
- probe2.'inspect'('lt')
- probe2.'inspect'('gt')
- probe2.'set_callback'('specific_callback')
- probe2.'set_finalize'('specific_finalize')
-
- # Create an instance of Instrument and
- # attach the probes to it.
- instr = new ['Instrument']
- instr.'attach'(probe)
- instr.'attach'(probe2)
-
- # Shift this file out of the command line argument list.
- me = shift args
- file = args[0]
-
- # Create globals for the counters.
- $P0 = new ['Integer']
- $P0 = 0
- set_global '$INSTR_CNT', $P0
-
- $P0 = new ['Integer']
- $P0 = 0
- set_global '$GT_CNT', $P0
-
- $P0 = new ['Integer']
- $P0 = 0
- set_global '$LT_CNT', $P0
-
- # Execute the file.
- instr.'run'(file, args)
-
- .return()
-.end
-
-.sub 'catchall_callback'
- .param string op_name
-
- # Update instruction counter.
- .local pmc counter
- counter = get_global '$INSTR_CNT'
- counter += 1
- set_global '$INSTR_CNT', counter
-
- .return()
-.end
-
-.sub 'catchall_finalize'
- # Print the total instructions executed.
- print 'Total Instruction count: '
- $P0 = get_global '$INSTR_CNT'
- say $P0
-
- .return()
-.end
-
-.sub 'specific_callback'
- .param string op_name
- .local int ind
- .local pmc counter
-
- # Check if it is lt or gt
- # and update accordingly.
- ind = index op_name, 'gt'
- if ind == 0 goto GT_OP
-
-LT_OP:
- counter = get_global '$LT_CNT'
- counter += 1
- set_global '$LT_CNT', counter
- goto DONE
-
-GT_OP:
- counter = get_global '$GT_CNT'
- counter += 1
- set_global '$GT_CNT', counter
-
-DONE:
- .return()
-.end
-
-
-.sub 'specific_finalize'
- .local pmc gt_cnt, lt_cnt
-
- gt_cnt = get_global '$GT_CNT'
- lt_cnt = get_global '$LT_CNT'
-
- print 'gt encountered '
- print gt_cnt
- say ' times'
-
- print 'lt encountered '
- print lt_cnt
- say ' times'
-
- .return()
-.end
-
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
More information about the parrot-commits
mailing list