[svn:parrot] r48031 - in branches/gsoc_instrument: runtime/parrot/library/Instrument src/dynpmc
khairul at svn.parrot.org
khairul at svn.parrot.org
Wed Jul 7 16:23:44 UTC 2010
Author: khairul
Date: Wed Jul 7 16:23:44 2010
New Revision: 48031
URL: https://trac.parrot.org/parrot/changeset/48031
Log:
Fixed code issues raised by cotto.
Modified:
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/src/dynpmc/instrument.pmc
branches/gsoc_instrument/src/dynpmc/instrumentgc.pmc
branches/gsoc_instrument/src/dynpmc/instrumentvtable.pmc
Modified: branches/gsoc_instrument/runtime/parrot/library/Instrument/Event.nqp
==============================================================================
--- branches/gsoc_instrument/runtime/parrot/library/Instrument/Event.nqp Wed Jul 7 15:19:45 2010 (r48030)
+++ branches/gsoc_instrument/runtime/parrot/library/Instrument/Event.nqp Wed Jul 7 16:23:44 2010 (r48031)
@@ -112,12 +112,12 @@
=end
sub _raise_event ($evt, $data) {
- my $hash := Q:PIR { %r = new ['Hash'] };
- pir::set_p_k_p($hash, 'type', 'event');
- pir::set_p_k_p($hash, 'subtype', $evt);
- pir::set_p_k_p($hash, 'data', $data);
+ my %hash := {};
+ %hash<type> := 'event';
+ %hash<subtype> := $evt;
+ %hash<data> := $data;
- my $task := pir::new_p_s_p__PSP('Task', $hash);
+ my $task := pir::new__PSP('Task', %hash);
pir::schedule($task);
}
Modified: branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp
==============================================================================
--- branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp Wed Jul 7 15:19:45 2010 (r48030)
+++ branches/gsoc_instrument/runtime/parrot/library/Instrument/EventLibrary.nqp Wed Jul 7 16:23:44 2010 (r48031)
@@ -146,14 +146,14 @@
=end
class Instrument::Event::GC is Instrument::Event {
- has $!probe_list;
+ has @!probe_list;
method _self_init() {
- $!probe_list := Q:PIR { %r = new ['ResizablePMCArray'] };
+ @!probe_list := ();
};
method inspect($item) {
- $!probe_list.push($item);
+ @!probe_list.push($item);
};
method _on_attach() {
@@ -173,10 +173,10 @@
# For each item in $!probe_list, insert the gc hook
# and register the event handler.
- for $!probe_list {
- my $hooks := $gc.get_hook_list($_);
+ for @!probe_list {
+ my @hooks := $gc.get_hook_list($_);
- for $hooks {
+ for @hooks {
$gc.insert_gc_hook($_);
my $tokens := pir::split__PSS('_', $_);
@@ -192,6 +192,58 @@
}
}
};
+
+ method disable() {
+ }
+};
+
+# Incomplete.
+class Instrument::Event::Class is Instrument::Event {
+ has $!class_name;
+ has @!vtable_probes;
+ has @!method_probes;
+
+ method _self_init() {
+ @!vtable_probes := ();
+ @!method_probes := ();
+ };
+
+ method inspect_class($class) {
+ $!class_name := $class;
+ };
+
+ method inspect_vtable($item) {
+ @!vtable_probes.push($item);
+ };
+
+ method inspect_method($item) {
+ @!method_probes.push($item);
+ };
+
+ method _on_attach() {
+ self.enable();
+ };
+
+ method enable() {
+ my $dispatcher := Q:PIR {
+ $P0 = getattribute self, '$!instr_obj'
+ %r = $P0['eventdispatcher']
+ };
+
+ my $class := $!instr_obj.instrument_class($!class_name);
+ my $event_prefix := 'Class::' ~ $!class_name ~ '::';
+
+ # Register the vtable probes.
+ for @!vtable_probes {
+ $class.insert_vtable_hook($_);
+
+ my $event := $event_prefix ~ $_;
+ $dispatcher.register($event, $!callback);
+ }
+ };
+
+ method disable() {
+ };
};
# 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 Wed Jul 7 15:19:45 2010 (r48030)
+++ branches/gsoc_instrument/runtime/parrot/library/Instrument/Probe.nqp Wed Jul 7 16:23:44 2010 (r48031)
@@ -35,10 +35,10 @@
class Instrument::Probe is Instrument::Base {
has $!is_catchall;
- has $!oplist;
- has $!todo_oplist;
+ has @!oplist;
+ has @!todo_oplist;
our $loadlib_evt;
- our $loadlib_probelist := Q:PIR { %r = new ['ResizablePMCArray'] };
+ our @loadlib_probelist := ();
=begin
@@ -51,8 +51,8 @@
=end
method _self_init () {
- $!todo_oplist := Q:PIR { %r = new ['ResizablePMCArray'] };
- $!oplist := Q:PIR { %r = new ['ResizablePMCArray'] };
+ @!todo_oplist := ();
+ @!oplist := ();
$!is_catchall := 0;
};
@@ -94,7 +94,7 @@
}
else {
# $op is singular.
- my $oplib := Q:PIR { %r = new ['OpLib'] };
+ my $oplib := pir::new__PS('OpLib');
my $type := pir::typeof__PP($op);
if $type eq 'Integer' {
@@ -102,10 +102,10 @@
if $op > pir::set__IP($oplib) {
# op number is invalid.
# Put it in the todo list.
- $!todo_oplist.push($op);
+ @!todo_oplist.push($op);
}
else {
- $!oplist.push($op);
+ @!oplist.push($op);
}
}
else {
@@ -118,20 +118,20 @@
# $op = short name.
for $op_ret {
$op_num := pir::set__IP($_);
- $!oplist.push($op_num);
+ @!oplist.push($op_num);
}
}
else {
# $op = long name.
$op_ret := pir::set_p_p_k__PPP($oplib, $op);
$op_num := pir::set__IP($op_ret);
- $!oplist.push($op_num);
+ @!oplist.push($op_num);
}
}
}
CATCH {
# Push to todo_oplist
- $!todo_oplist.push($op);
+ @!todo_oplist.push($op);
}
};
@@ -157,22 +157,23 @@
}
# Check for any todo_oplist.
- if pir::set__IP($!todo_oplist) != 0 {
+ if pir::set__IP(@!todo_oplist) != 0 {
# Double check the todo_oplist.
- my $list := $!todo_oplist;
- $!todo_oplist := Q:PIR { %r = new ['ResizablePMCArray'] };
- for $list {
+ my @list := @!todo_oplist;
+ @!todo_oplist := ();
+ for @list {
self.inspect($_);
}
# If there is still a todo_oplist,
# set up an event handler to update.
- if pir::set__IP($!todo_oplist) != 0 {
- $Instrument::Probe::loadlib_probelist.push(self);
+ if pir::set__IP(@!todo_oplist) != 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(pir::get_global__PS('loadlib_callback'));
+ $Instrument::Probe::loadlib_evt.callback($callback);
$Instrument::Probe::loadlib_evt.data(self);
$!instr_obj.attach($Instrument::Probe::loadlib_evt);
}
@@ -185,7 +186,7 @@
$!instr_obj.insert_op_catchall(self);
} else {
# Attach a hook to each op in @!oplist.
- for $!oplist {
+ for @!oplist {
$!instr_obj.insert_op_hook(self, $_);
}
}
@@ -219,7 +220,7 @@
$!instr_obj.remove_op_catchall(self);
} else {
# Attach a hook to each op in @!oplist.
- for $!oplist {
+ for @!oplist {
$!instr_obj.remove_op_hook(self, $_);
}
}
@@ -237,7 +238,7 @@
=end
method get_op_list () {
- return $!oplist;
+ return @!oplist;
}
=begin
@@ -249,16 +250,16 @@
=end
method get_op_todo_list () {
- return $!todo_oplist;
+ return @!todo_oplist;
}
# Internal helper: Callback for loadlib events registered when the probe has
# any outstanding ops in $!todo_oplist.
sub loadlib_callback ($data) {
# Simply disable and reenable the probe.
- my $list := $Instrument::Probe::loadlib_probelist;
- $Instrument::Probe::loadlib_probelist := Q:PIR { %r = new ['ResizablePMCArray'] };
- for $list {
+ my @list := @Instrument::Probe::loadlib_probelist;
+ @Instrument::Probe::loadlib_probelist := ();
+ for @list {
$_.disable();
$_.enable();
}
Modified: branches/gsoc_instrument/src/dynpmc/instrument.pmc
==============================================================================
--- branches/gsoc_instrument/src/dynpmc/instrument.pmc Wed Jul 7 15:19:45 2010 (r48030)
+++ branches/gsoc_instrument/src/dynpmc/instrument.pmc Wed Jul 7 16:23:44 2010 (r48031)
@@ -537,6 +537,20 @@
RETURN(INTVAL count);
}
+
+
+ METHOD instrument_class(STRING *classname) {
+ INTVAL class_type;
+ PMC *class_instr;
+
+ class_type = Parrot_pmc_get_type_str(INTERP, CONST_STRING(INTERP, "InstrumentVtable"));
+ class_instr = Parrot_pmc_new_init(INTERP, class_type, SELF);
+
+ () = PCCINVOKE(INTERP, class_instr, "attach_to_class", STRING *classname);
+
+ RETURN(PMC *class_instr);
+ }
+
}
/*
Modified: branches/gsoc_instrument/src/dynpmc/instrumentgc.pmc
==============================================================================
--- branches/gsoc_instrument/src/dynpmc/instrumentgc.pmc Wed Jul 7 15:19:45 2010 (r48030)
+++ branches/gsoc_instrument/src/dynpmc/instrumentgc.pmc Wed Jul 7 16:23:44 2010 (r48031)
@@ -162,9 +162,9 @@
supervised->gc_sys = (GC_Subsystem *) attr->gc_instrumented;
/* Initialise the hashes. */
- attr->stub_hash = parrot_new_pointer_hash(INTERP);
- attr->original_hash = parrot_new_pointer_hash(INTERP);
- attr->entry_hash = parrot_new_pointer_hash(INTERP);
+ attr->stub_hash = parrot_new_hash(INTERP);
+ attr->original_hash = parrot_new_hash(INTERP);
+ attr->entry_hash = parrot_new_hash(INTERP);
build_gc_func_hash(INTERP, attr->stub_hash, attr->original_hash, attr->entry_hash,
attr->gc_instrumented, attr->gc_original);
@@ -375,22 +375,18 @@
VTABLE_push_string(INTERP, list, CONST_STRING(INTERP, "unblock_sweep"));
}
else {
- /* Convert name to a constant string since we use the address of the
- constant string as the key to the various hashes. */
+ /* Ensure that con_str is the name of a hook before pushing it in. */
size_t *check;
Hash *stub_hash;
- char *c_str = Parrot_str_to_cstring(INTERP, name);
- STRING *con_str = CONST_STRING(INTERP, c_str);
- VTABLE_push_string(INTERP, list, con_str);
- Parrot_free_cstring(c_str);
- /* Ensure that con_str is the name of a hook. */
GETATTR_InstrumentGC_stub_hash(INTERP, SELF, stub_hash);
- check = (size_t *) parrot_hash_get(INTERP, stub_hash, con_str);
+ check = (size_t *) parrot_hash_get(INTERP, stub_hash, name);
if (check == NULL) {
Parrot_ex_throw_from_c_args(INTERP, NULL, 1,
- "Unknown GC function: %Ss", con_str);
+ "Unknown GC function: %Ss", name);
}
+
+ VTABLE_push_string(INTERP, list, name);
}
RETURN(PMC *list);
Modified: branches/gsoc_instrument/src/dynpmc/instrumentvtable.pmc
==============================================================================
--- branches/gsoc_instrument/src/dynpmc/instrumentvtable.pmc Wed Jul 7 15:19:45 2010 (r48030)
+++ branches/gsoc_instrument/src/dynpmc/instrumentvtable.pmc Wed Jul 7 16:23:44 2010 (r48031)
@@ -242,13 +242,13 @@
attr->instrument = instrument;
attr->original_vtable = NULL;
attr->instrumented_vtable = NULL;
- attr->original_hash = parrot_new_pointer_hash(INTERP);
- attr->instrumented_hash = parrot_new_pointer_hash(INTERP);
+ attr->original_hash = parrot_new_hash(INTERP);
+ attr->instrumented_hash = parrot_new_hash(INTERP);
/* Initialise the Instrumented Vtable registry if needed. */
if (Instrument_Vtable_Entries == NULL) {
- Instrument_Vtable_Entries = parrot_new_pointer_hash(INTERP);
- Instrument_Vtable_Stubs = parrot_new_pointer_hash(INTERP);
+ Instrument_Vtable_Entries = parrot_new_hash(INTERP);
+ Instrument_Vtable_Stubs = parrot_new_hash(INTERP);
}
PObj_custom_destroy_SET(SELF);
@@ -293,44 +293,32 @@
attr->original_vtable, attr->instrumented_vtable);
}
- METHOD insert_vtable_hook(STRING *vtable_str) {
+ METHOD insert_vtable_hook(STRING *key) {
Parrot_InstrumentVtable_attributes * const attr = PARROT_INSTRUMENTVTABLE(SELF);
- STRING *key;
char *con_string;
size_t **instr, *stub;
- /* Convert vtable_str to a constant STRING so that it can be used as a key. */
- con_string = Parrot_str_to_cstring(INTERP, vtable_str);
- key = CONST_STRING(INTERP, con_string);
- Parrot_free_cstring(con_string);
-
/* Modify the entry. */
instr = (size_t **) parrot_hash_get(INTERP, attr->instrumented_hash, key);
stub = (size_t *) parrot_hash_get(INTERP, Instrument_Vtable_Stubs, key);
if (instr == NULL || stub == NULL) {
Parrot_ex_throw_from_c_args(INTERP, NULL, 1,
- "Unknown VTABLE entry: %Ss", vtable_str);
+ "Unknown VTABLE entry: %Ss", key);
}
*instr = stub;
}
- METHOD remove_vtable_hook(STRING *vtable_str) {
+ METHOD remove_vtable_hook(STRING *key) {
Parrot_InstrumentVtable_attributes * const attr = PARROT_INSTRUMENTVTABLE(SELF);
- STRING *key;
char *con_string;
size_t **instr, *orig;
- /* Convert vtable_str to a constant STRING so that it can be used as a key. */
- con_string = Parrot_str_to_cstring(INTERP, vtable_str);
- key = CONST_STRING(INTERP, con_string);
- Parrot_free_cstring(con_string);
-
/* Modify the entry. */
instr = (size_t **) parrot_hash_get(INTERP, attr->instrumented_hash, key);
orig = (size_t *) parrot_hash_get(INTERP, attr->original_hash, key);
if (instr == NULL || orig == NULL) {
Parrot_ex_throw_from_c_args(INTERP, NULL, 1,
- "Unknown VTABLE entry: %Ss", vtable_str);
+ "Unknown VTABLE entry: %Ss", key);
}
*instr = orig;
}
More information about the parrot-commits
mailing list