[svn:parrot] r48269 - in branches/gsoc_instrument: config/gen/makefiles runtime/parrot/library/Instrument t/dynpmc
khairul at svn.parrot.org
khairul at svn.parrot.org
Tue Aug 3 03:28:01 UTC 2010
Author: khairul
Date: Tue Aug 3 03:28:01 2010
New Revision: 48269
URL: https://trac.parrot.org/parrot/changeset/48269
Log:
Updated runtime library
Deleted:
branches/gsoc_instrument/runtime/parrot/library/Instrument/EventDispatcher.nqp
Modified:
branches/gsoc_instrument/config/gen/makefiles/root.in
branches/gsoc_instrument/runtime/parrot/library/Instrument/Event.nqp
branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp
branches/gsoc_instrument/runtime/parrot/library/Instrument/Probe.nqp
branches/gsoc_instrument/t/dynpmc/instrumentvtable.t
Modified: branches/gsoc_instrument/config/gen/makefiles/root.in
==============================================================================
--- branches/gsoc_instrument/config/gen/makefiles/root.in Tue Aug 3 03:23:30 2010 (r48268)
+++ branches/gsoc_instrument/config/gen/makefiles/root.in Tue Aug 3 03:28:01 2010 (r48269)
@@ -333,7 +333,6 @@
$(LIBRARY_DIR)/Instrument/Base.pbc \
$(LIBRARY_DIR)/Instrument/Probe.pbc \
$(LIBRARY_DIR)/Instrument/Event.pbc \
- $(LIBRARY_DIR)/Instrument/EventDispatcher.pbc \
$(LIBRARY_DIR)/Instrument/EventLibrary.pbc
FLUID_FILES_1 = \
@@ -1131,12 +1130,10 @@
$(LIBRARY_DIR)/Instrument/InstrumentLib.pbc: $(LIBRARY_DIR)/Instrument/Instrument.pbc \
$(LIBRARY_DIR)/Instrument/Base.pbc $(LIBRARY_DIR)/Instrument/Probe.pbc \
- $(LIBRARY_DIR)/Instrument/EventDispatcher.pbc $(LIBRARY_DIR)/Instrument/Event.pbc \
- $(LIBRARY_DIR)/Instrument/EventLibrary.pbc
+ $(LIBRARY_DIR)/Instrument/EventLibrary.pbc $(LIBRARY_DIR)/Instrument/Event.pbc
$(PBC_MERGE) -o $@ $(LIBRARY_DIR)/Instrument/Instrument.pbc \
$(LIBRARY_DIR)/Instrument/Base.pbc $(LIBRARY_DIR)/Instrument/Probe.pbc \
- $(LIBRARY_DIR)/Instrument/EventDispatcher.pbc $(LIBRARY_DIR)/Instrument/Event.pbc \
- $(LIBRARY_DIR)/Instrument/EventLibrary.pbc
+ $(LIBRARY_DIR)/Instrument/EventLibrary.pbc $(LIBRARY_DIR)/Instrument/Event.pbc
$(LIBRARY_DIR)/Instrument/Base.pir: $(LIBRARY_DIR)/Instrument/Base.nqp $(NQP_RX)
$(NQP_RX) --target=pir $(LIBRARY_DIR)/Instrument/Base.nqp > $@
@@ -1144,9 +1141,6 @@
$(LIBRARY_DIR)/Instrument/Probe.pir: $(LIBRARY_DIR)/Instrument/Probe.nqp $(NQP_RX)
$(NQP_RX) --target=pir $(LIBRARY_DIR)/Instrument/Probe.nqp > $@
-$(LIBRARY_DIR)/Instrument/EventDispatcher.pir: $(LIBRARY_DIR)/Instrument/EventDispatcher.nqp $(NQP_RX)
- $(NQP_RX) --target=pir $(LIBRARY_DIR)/Instrument/EventDispatcher.nqp > $@
-
$(LIBRARY_DIR)/Instrument/Event.pir: $(LIBRARY_DIR)/Instrument/Event.nqp $(NQP_RX)
$(NQP_RX) --target=pir $(LIBRARY_DIR)/Instrument/Event.nqp > $@
Modified: branches/gsoc_instrument/runtime/parrot/library/Instrument/Event.nqp
==============================================================================
--- branches/gsoc_instrument/runtime/parrot/library/Instrument/Event.nqp Tue Aug 3 03:23:30 2010 (r48268)
+++ branches/gsoc_instrument/runtime/parrot/library/Instrument/Event.nqp Tue Aug 3 03:28:01 2010 (r48269)
@@ -5,11 +5,11 @@
=begin
=head1 NAME
-
+
runtime/parrot/library/Instrument/Event.nqp - Abstract class for the Instruments library
=head1 SYNOPSIS
-
+
Abstract class for the Instruments library.
Provides event specific methods.
@@ -65,13 +65,8 @@
$!instr_obj.attach($!probe_obj);
}
- my $dispatcher := Q:PIR {
- $P0 = getattribute self, '$!instr_obj'
- %r = $P0['eventdispatcher']
- };
-
if pir::defined__IP($!callback) {
- $dispatcher.register($!event_type, $!callback);
+ $!instr_obj.register_eventhandler($!event_type, self);
}
};
Deleted: branches/gsoc_instrument/runtime/parrot/library/Instrument/EventDispatcher.nqp
==============================================================================
--- branches/gsoc_instrument/runtime/parrot/library/Instrument/EventDispatcher.nqp Tue Aug 3 03:28:01 2010 (r48268)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,203 +0,0 @@
-#! nqp
-# Copyright (C) 2010, Parrot Foundation.
-# $Id$
-
-=begin
-
-=head1 NAME
-
-runtime/parrot/library/Instrument/EventDispatcher.nqp
-
- Specific eventhandler to handle Instrument related events.
-
-=head1 SYNOPSIS
-
- Each Instrument instance has an instance of this class,
- which will intercept all events raised and handle those which
- has eventhandlers registered with it.
-
-=cut
-
-=end
-
-class Instrument::EventDispatcher is EventHandler {
- has %!callbacks;
-
-=begin
-
-=item new ()
-
-Overrides the default constructor provided in P6object.pbc.
-Initialises $!identifer and then calls the subclass specific
-_self_init method.
-
-=cut
-
-=end
-
- method new () {
- self := Q:PIR {
- $P0 = self.'HOW'()
- $P1 = getattribute $P0, 'parrotclass'
- %r = new $P1
- };
-
- self._self_init();
-
- return self;
- };
-
-=begin
-
-=item _self_init ()
-
-Private method to perform required initialisation.
-
-=cut
-
-=end
-
- method _self_init () {
- %!callbacks := {};
-
- Q:PIR {
- $P0 = get_global 'handler'
- setattribute self, 'code', $P0
- addhandler self
- };
- };
-
-=begin
-
-=item can_handle ($task)
-
-Overrides the can_handle method of parent EventHandler
-and handle only tasks with subtype 'Instrument'.
-
-=cut
-
-=end
-
- method can_handle ($task) {
- pir::getattribute__PPS($task, "subtype") eq 'Instrument';
- };
-
-=begin
-
-=item register ($event, $callback)
-
-Registers the handler for the given event.
-
-=cut
-
-=end
-
- method register ($event, $callback) {
- my @list := get_list(%!callbacks, $event);
- @list.push($callback);
- };
-
-=begin
-
-=item deregister ($event, $callback)
-
-Removes the handler for the given event.
-
-=cut
-
-=end
-
- method deregister ($event, $callback) {
- my @list := get_list(%!callbacks, $event);
-
- # Look for $callback in @list.
- my $found := 0;
- my $index := 0;
- for @list {
- if pir::defined__IP($_) && $_ eq $callback {
- pir::delete(@list, $index);
- $found := 1;
- break;
- }
- $index++;
- }
-
- # Check that the callback was found and removed.
- if !$found {
- die('Callback for event "' ~ $event ~ '" was not found.');
- }
- };
-
-=begin
-
-=item get_handlers ($event)
-
-Returns a ResizablePMCArray of all the handlers registered for that event.
-$event can be an array or a string.
-
-=cut
-
-=end
-
- method get_handlers ($event) {
- my @tokens := $event;
- if pir::does__IPS($event, 'string') {
- @tokens := pir::split__PSS('::', $event);
- }
-
- # Get the lists and join them into 1 big list.
- my @key := ();
- my @list := ();
-
- for @tokens {
- @key.push($_);
- @list.append(get_list(%!callbacks, pir::join__SSP('::', @key)));
- }
-
- return @list;
- }
-
-=begin
-
-=item handler ($event, $callback)
-
-Helper sub that acts as the callback for the EventDispatcher
-to dispatch the events to all the appropriate handler(s) registered
-with it.
-
-=cut
-
-=end
-
- sub handler ($handler, $task) {
- # Get the required subkeys.
- my %data := pir::getattribute__PPS($task, "data");
-
- # Get the list of callbacks for this event.
- my @list := $handler.get_handlers(%data<event>);
-
- # Call the callbacks.
- for @list {
- $_(%data);
- }
- };
-
-=begin
-
-=item get_list ($hash, $key)
-
-Returns a ResizablePMCArray object for the given key in
-the given hash. If the key does not exists, create an entry
-for it.
-
-=cut
-
-=end
-
- sub get_list (%hash, $key) {
- %hash{$key} := %hash{$key} // ();
- return %hash{$key};
- };
-};
-
-# vim: ft=perl6 expandtab shiftwidth=4:
Modified: branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp
==============================================================================
--- branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp Tue Aug 3 03:23:30 2010 (r48268)
+++ branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp Tue Aug 3 03:28:01 2010 (r48269)
@@ -87,10 +87,6 @@
$P0 = getattribute self, '$!instr_obj'
%r = $P0['gc']
};
- my $dispatcher := Q:PIR {
- $P0 = getattribute self, '$!instr_obj'
- %r = $P0['eventdispatcher']
- };
# For each item in $!probe_list, insert the gc hook
# and register the event handler.
@@ -100,11 +96,11 @@
for @hooks {
$gc.insert_hook($_);
- my $group := $gc.get_hook_group($_).shift();
+ my $group := $gc.get_hook_group($_);
my $event := 'GC::' ~ $group ~ '::' ~ $_;
# Register the callback.
- $dispatcher.register($event, $!callback);
+ $!instr_obj.register_eventhandler($event, self);
}
}
@@ -119,10 +115,6 @@
$P0 = getattribute self, '$!instr_obj'
%r = $P0['gc']
};
- my $dispatcher := Q:PIR {
- $P0 = getattribute self, '$!instr_obj'
- %r = $P0['eventdispatcher']
- };
# For each item in $!probe_list, insert the gc hook
# and register the event handler.
@@ -132,11 +124,11 @@
for @hooks {
$gc.remove_hook($_);
- my $group := $gc.get_hook_group($_).shift();
+ my $group := $gc.get_hook_group($_);
my $event := 'GC::' ~ $group ~ '::' ~ $_;
# Register the callback.
- $dispatcher.deregister($event, $!callback);
+ $!instr_obj.remove_eventhandler($event, self);
}
}
@@ -152,9 +144,6 @@
has @!class_names;
has @!vtable_probes;
has @!method_probes;
- our @todo;
- our $loadlib_event;
- our $loadbytecode_event;
method _self_init() {
@!class_names := ();
@@ -180,12 +169,6 @@
method enable() {
if $!is_enabled { return; }
-
- my $dispatcher := Q:PIR {
- $P0 = getattribute self, '$!instr_obj'
- %r = $P0['eventdispatcher']
- };
-
for (@!class_names) {
my $class_name := $_;
my $class := $!instr_obj.instrument_class($class_name);
@@ -195,13 +178,11 @@
my $vtable_prefix := $event_prefix ~ 'vtable::';
for @!vtable_probes {
my @hooks := $class.get_hook_list($_);
-
for @hooks {
$class.insert_hook($_);
- my $group := ($class.get_hook_group($_)).shift();
-
+ my $group := $class.get_hook_group($_);
my $event := $vtable_prefix ~ $group ~ '::' ~ $_;
- $dispatcher.register($event, $!callback);
+ $!instr_obj.register_eventhandler($event, self);
}
}
@@ -211,15 +192,10 @@
$class.insert_method_hook($_);
my $event := $method_prefix ~ $_;
- $dispatcher.register($event, $!callback);
+ $!instr_obj.register_eventhandler($event, self);
}
- CATCH {
- # Something was not found.
- # Push this probe to the todo list.
- @Instrument::Event::Class::todo.push(self);
- setup_load_event($!instr_obj);
- }
+ CATCH {}
}
$!is_enabled := 1;
@@ -228,11 +204,6 @@
method disable() {
if !$!is_enabled { return; }
- my $dispatcher := Q:PIR {
- $P0 = getattribute self, '$!instr_obj'
- %r = $P0['eventdispatcher']
- };
-
for (@!class_names) {
my $class_name := $_;
my $class := $!instr_obj.instrument_class($class_name);
@@ -245,10 +216,10 @@
for @hooks {
$class.remove_hook($_);
- my $group := ($class.get_hook_group($_)).shift();
+ my $group := $class.get_hook_group($_);
my $event := $vtable_prefix ~ $group ~ '::' ~ $_;
- $dispatcher.deregister($event, $!callback);
+ $!instr_obj.remove_eventhandler($event, self);
}
}
@@ -258,7 +229,7 @@
$class.remove_method_hook($_);
my $event := $method_prefix ~ $_;
- $dispatcher.deregister($event, $!callback);
+ $!instr_obj.remove_eventhandler($event, self);
}
CATCH {
@@ -271,41 +242,54 @@
$!is_enabled := 0;
};
+};
- sub setup_load_event($instrument) {
- if !pir::defined__IP($Instrument::Event::Class::loadlib_event) {
- # Define the loadlib event for this class.
- my $loadlib := Instrument::Event::Internal::loadlib.new();
- $loadlib.callback(pir::get_global__PS("load_cb"));
- $instrument.attach($loadlib);
- $Instrument::Event::Class::loadlib_event := $loadlib;
-
- # Define the load_bytecode event for this class.
- my $bytecode := Instrument::Probe.new();
- $bytecode.inspect('load_bytecode');
- $bytecode.callback(pir::get_global__PS("loadbytecode_cb"));
- $instrument.attach($bytecode);
- $Instrument::Event::Class::loadbytecode_event := $bytecode;
- }
+class Instrument::Event::Object is Instrument::Event::Class {
+ has $!object;
+
+ method _self_init() {
+ #$!object := pir::null;
+ #$!instrumented_obj := pir::null;
+ @!vtable_probes := ();
+ @!method_probes := ();
};
- sub load_cb($data) {
- reload_todos();
- }
+ method enable () {
+ if !+$!is_enabled {
+ my $event_prefix := 'Object::' ~ $!object.get_address() ~ '::';
- sub loadbytecode_cb($op, $instr, $probe) {
- return pir::get_global__PS('reload_todos');
- }
+ # Register the vtable probes.
+ my $vtable_prefix := $event_prefix ~ 'vtable::';
+ for @!vtable_probes {
+ my @hooks := $!object.get_hook_list($_);
+
+ for @hooks {
+ $!object.insert_hook($_);
+ my $group := ($!object.get_hook_group($_)).shift();
+
+ my $event := $vtable_prefix ~ $group ~ '::' ~ $_;
+ $!instr_obj.register_eventhandler($event, self);
+ }
+ }
+
+ # Register the method probes.
+ my $method_prefix := $event_prefix ~ 'method::';
+ for @!method_probes {
+ $!object.insert_method_hook($_);
+
+ my $event := $method_prefix ~ $_;
+ $!instr_obj.register_eventhandler($event, self);
+ }
+
+ CATCH {}
- sub reload_todos() {
- my @list := @Instrument::Event::Class::todo;
- @Instrument::Event::Class::todo := ();
-
- for @list {
- $_.disable();
- $_.enable();
+ $!is_enabled := 1;
}
- };
-};
+ }
+
+ method get_address() {
+ return $!object.get_address();
+ }
+}
# vim: ft=perl6 expandtab shiftwidth=4:
Modified: branches/gsoc_instrument/runtime/parrot/library/Instrument/Probe.nqp
==============================================================================
--- branches/gsoc_instrument/runtime/parrot/library/Instrument/Probe.nqp Tue Aug 3 03:23:30 2010 (r48268)
+++ branches/gsoc_instrument/runtime/parrot/library/Instrument/Probe.nqp Tue Aug 3 03:28:01 2010 (r48269)
@@ -35,10 +35,9 @@
class Instrument::Probe is Instrument::Base {
has $!is_catchall;
+ has $!rc_obj;
has @!oplist;
has @!op_todo_list;
- our $loadlib_evt;
- our @loadlib_probelist := ();
=begin
@@ -154,30 +153,16 @@
for @list {
self.inspect($_);
}
-
- # If there is still a op_todo_list,
- # set up an event handler to update.
- if +@!op_todo_list != 0 {
- @Instrument::Probe::loadlib_probelist.push(self);
-
- if !pir::defined__IP($Instrument::Probe::loadlib_evt) {
- my $callback := pir::get_global__PS('loadlib_callback');
- $Instrument::Probe::loadlib_evt := Instrument::Event::Internal::loadlib.new();
- $Instrument::Probe::loadlib_evt.callback($callback);
- $Instrument::Probe::loadlib_evt.data(self);
- $!instr_obj.attach($Instrument::Probe::loadlib_evt);
- }
- }
}
if !$!is_enabled {
if $!is_catchall {
# Attach a catchall hook.
- $!instr_obj.insert_op_catchall(self);
+ $!rc_obj.insert_op_catchall(self);
} else {
# Attach a hook to each op in @!oplist.
for @!oplist {
- $!instr_obj.insert_op_hook(self, $_);
+ $!rc_obj.insert_op_hook(self, $_);
}
}
@@ -207,11 +192,11 @@
if $!is_enabled {
if $!is_catchall {
# Attach a catchall hook.
- $!instr_obj.remove_op_catchall(self);
+ $!rc_obj.remove_op_catchall(self);
} else {
# Attach a hook to each op in @!oplist.
for @!oplist {
- $!instr_obj.remove_op_hook(self, $_);
+ $!rc_obj.remove_op_hook(self, $_);
}
}
@@ -242,18 +227,6 @@
method get_op_todo_list () {
@!op_todo_list;
}
-
- # Internal helper: Callback for loadlib events registered when the probe has
- # any outstanding ops in @!op_todo_list.
- sub loadlib_callback ($data) {
- # Simply disable and reenable the probe.
- my @list := @Instrument::Probe::loadlib_probelist;
- @Instrument::Probe::loadlib_probelist := ();
- for @list {
- $_.disable();
- $_.enable();
- }
- }
};
# vim: ft=perl6 expandtab shiftwidth=4:
Modified: branches/gsoc_instrument/t/dynpmc/instrumentvtable.t
==============================================================================
--- branches/gsoc_instrument/t/dynpmc/instrumentvtable.t Tue Aug 3 03:23:30 2010 (r48268)
+++ branches/gsoc_instrument/t/dynpmc/instrumentvtable.t Tue Aug 3 03:28:01 2010 (r48269)
@@ -186,9 +186,9 @@
## Scenario 4: Insert a group of hooks.
$P1 = new ['InstrumentVtable'], $P0
$P1.'attach_to_class'('Sub')
- $P1.'insert_hook'('write')
+ $P1.'insert_hook'('math')
$P2 = $P1.'get_instrumented_list'()
- $P3 = $P1.'get_hook_list'('write')
+ $P3 = $P1.'get_hook_list'('math')
$I0 = $P2
$I1 = $P3
@@ -232,8 +232,8 @@
## Scenario 3: Remove a group of hooks.
$P1 = new ['InstrumentVtable'], $P0
$P1.'attach_to_class'('Sub')
- $P1.'insert_hook'('write')
- $P1.'remove_hook'('write')
+ $P1.'insert_hook'('math')
+ $P1.'remove_hook'('math')
$P2 = $P1.'get_instrumented_list'()
$I0 = $P2
@@ -309,11 +309,13 @@
# Test event.
$P10 = $P9['event']
$S0 = join '::', $P10
- is($S0, 'Class::TestClass::vtable::core::init', 'Event: Event ok')
+ is($S0, 'Class::TestClass::vtable::main::init', 'Event: Event ok')
.end
.sub test_notification_cb
.param pmc data
+ .param pmc instr
+ .param pmc probe
$P0 = get_global '%notification'
$P0['called'] = 1
More information about the parrot-commits
mailing list