[svn:parrot] r47093 - in branches/gsoc_instrument: . config/gen/makefiles examples/library runtime/parrot/library/Instrument src/dynpmc t/dynpmc

khairul at svn.parrot.org khairul at svn.parrot.org
Fri May 28 15:29:38 UTC 2010


Author: khairul
Date: Fri May 28 15:29:38 2010
New Revision: 47093
URL: https://trac.parrot.org/parrot/changeset/47093

Log:
Rewrote runtime library in NQP

Added:
   branches/gsoc_instrument/runtime/parrot/library/Instrument/Probe.nqp
Deleted:
   branches/gsoc_instrument/runtime/parrot/library/Instrument/Probe.pir
Modified:
   branches/gsoc_instrument/MANIFEST
   branches/gsoc_instrument/config/gen/makefiles/root.in
   branches/gsoc_instrument/examples/library/tracer.pir
   branches/gsoc_instrument/runtime/parrot/library/Instrument/Instrument.pir
   branches/gsoc_instrument/src/dynpmc/instrument.pmc
   branches/gsoc_instrument/t/dynpmc/instrument.t

Modified: branches/gsoc_instrument/MANIFEST
==============================================================================
--- branches/gsoc_instrument/MANIFEST	Fri May 28 15:25:07 2010	(r47092)
+++ branches/gsoc_instrument/MANIFEST	Fri May 28 15:29:38 2010	(r47093)
@@ -1157,7 +1157,7 @@
 runtime/parrot/library/HTTP/Daemon.pir                      [library]
 runtime/parrot/library/HTTP/Message.pir                     [library]
 runtime/parrot/library/Instrument/Instrument.pir            [library]
-runtime/parrot/library/Instrument/Probe.pir                 [library]
+runtime/parrot/library/Instrument/Probe.nqp                 [library]
 runtime/parrot/library/Iter.pir                             [library]
 runtime/parrot/library/JSON.pir                             [library]
 runtime/parrot/library/LWP/Protocol.pir                     [library]

Modified: branches/gsoc_instrument/config/gen/makefiles/root.in
==============================================================================
--- branches/gsoc_instrument/config/gen/makefiles/root.in	Fri May 28 15:25:07 2010	(r47092)
+++ branches/gsoc_instrument/config/gen/makefiles/root.in	Fri May 28 15:29:38 2010	(r47093)
@@ -328,7 +328,7 @@
     $(LIBRARY_DIR)/libpcre.pbc \
     $(LIBRARY_DIR)/postgres.pbc \
     $(LIBRARY_DIR)/Instrument/Instrument.pbc \
-    $(LIBRARY_DIR)/Instrument/Probe.pbc 
+	$(LIBRARY_DIR)/Instrument/Probe.pbc
 
 FLUID_FILES_1 = \
     $(GEN_HEADERS) \
@@ -1091,6 +1091,11 @@
 	$(NQP_RX) --target=pir $(LIBRARY_DIR)/ProfTest/Matcher.nqp > $@
 
 
+$(LIBRARY_DIR)/Instrument/Probe.pbc: $(LIBRARY_DIR)/Instrument/Probe.pir
+	$(PARROT) -o $@ $(LIBRARY_DIR)/Instrument/Probe.pir
+
+$(LIBRARY_DIR)/Instrument/Probe.pir: $(LIBRARY_DIR)/Instrument/Probe.nqp $(NQP_RX)
+	$(NQP_RX) --target=pir $(LIBRARY_DIR)/Instrument/Probe.nqp > $@
 
 ###############################################################################
 #

Modified: branches/gsoc_instrument/examples/library/tracer.pir
==============================================================================
--- branches/gsoc_instrument/examples/library/tracer.pir	Fri May 28 15:25:07 2010	(r47092)
+++ branches/gsoc_instrument/examples/library/tracer.pir	Fri May 28 15:29:38 2010	(r47093)
@@ -29,7 +29,8 @@
     
     # Create a catchall probe which will be called for
     #  each op.
-    probe = new ['Instrument';'Probe';'Catchall']
+    probe = new ['Instrument';'Probe']
+    probe.'make_catchall'()
     probe.'set_callback'('catchall_callback')
     probe.'set_finalize'('catchall_finalize')
     

Modified: branches/gsoc_instrument/runtime/parrot/library/Instrument/Instrument.pir
==============================================================================
--- branches/gsoc_instrument/runtime/parrot/library/Instrument/Instrument.pir	Fri May 28 15:25:07 2010	(r47092)
+++ branches/gsoc_instrument/runtime/parrot/library/Instrument/Instrument.pir	Fri May 28 15:29:38 2010	(r47093)
@@ -14,7 +14,8 @@
 
 .sub '__instrument_lib_init' :init :load :anon
     .local pmc lib
-
+    load_bytecode 'P6object.pbc'
+    
     lib = loadlib 'instrument'
     $I0 = defined lib
     if $I0 goto END
@@ -25,6 +26,11 @@
     .return()
 .end
 
+.sub 'say'
+    .param pmc msg
+    say msg
+.end
+
 # Local Variables:
 #   mode: pir
 #   fill-column: 100

Added: branches/gsoc_instrument/runtime/parrot/library/Instrument/Probe.nqp
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ branches/gsoc_instrument/runtime/parrot/library/Instrument/Probe.nqp	Fri May 28 15:29:38 2010	(r47093)
@@ -0,0 +1,257 @@
+#! nqp
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+=begin
+
+=head1 NAME
+    
+runtime/parrot/library/Instrument/Probe.nqp - Helper class to automate inserting and removing hooks from the interpreter.
+
+=head1 SYNOPSIS
+    
+    ## In PIR.
+    
+    # Create a probe that will be called whenever the
+    #  specified ops are encountered.
+    probe = new ['Instrument';'Probe']
+    probe.'inspect'('lt')
+    probe.'inspect'('gt')
+    probe.'set_callback'('specific_callback')
+    probe.'set_finalize'('specific_finalize')
+    
+    # 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')
+
+=cut
+
+=end
+
+class Instrument::Probe {
+    has $!instr_obj;
+    has $!identifier;
+    has $!is_enabled;
+    has $!is_catchall;
+    has $!callback;
+    has $!finalize;
+    has $!oplist;
+    our $id_count;
+
+=begin
+
+=item set_callback(sub) or set_callback('sub')
+
+Set the sub callback to be called when the desired op is
+encountered. sub can be passed by name or reference through a 
+Sub PMC object.
+
+=cut
+
+=end
+
+    method set_callback ($sub) {
+        $!callback := get_sub_obj($sub);
+    };
+
+=begin
+
+=item set_finalize(sub) or set_finalize('sub')
+
+Set the sub callback to be called at the end of execution.
+sub can be passed by name or reference through a Sub PMC object.
+Sub will only be called if the probe is enabled at the end of execution.
+
+=cut
+
+=end
+
+    method set_finalize ($sub) {
+        $!finalize := get_sub_obj($sub);
+    };
+    
+=begin
+=item make_catchall()
+
+Set this probe to catch all ops.
+
+=cut
+=end
+    
+    method make_catchall () {
+        $!is_catchall := 1;
+    }
+
+=begin
+=item inspect(op)
+
+Add op to the list of ops that this probe's callback will be called on.
+op can be identified by op number, op short name and op full name.
+A list of ops can also be passed, eg. in NQP, $p.inspect(['gt','lt']);
+
+If a non-existant op is found, a warning message is printed out.
+
+TODO: A problem will be dynops. Since we are checking ops before
+      the code is even loaded, ops that exists in dynop libs are
+      considered non-existent. Create a deferred list that the 
+      instrument pmc will run before the first opcode is executed.
+
+=cut
+=end
+
+    method inspect ($op) {
+        if pir::does__IPS($op, 'array') {
+            # $op is a list.
+            for $op {
+                self.inspect($_);
+            }
+        } else {
+            # $op is singular.
+            my $type := pir::typeof__PP($op);
+            if !pir::defined__IP($!oplist) {
+                $!oplist := Q:PIR { %r = new ['ResizablePMCArray'] };
+            }
+
+            if $type eq 'Integer' {
+                # $op = op number.
+                $!oplist.push($op);
+            } else {
+                my $oplib := Q:PIR { %r = new ['OpLib'] };
+                
+                # Lookup the op.
+                my $op_ret;
+                my $op_num;
+                
+                $op_ret := $oplib.op_family($op);
+                if pir::defined__IP($op_ret) {
+                    # $op = short name.
+                    for $op_ret {
+                        $op_num := pir::set__IP($_);
+                        $!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);
+                }
+            }
+        }
+        CATCH { say('Warning: Op ' ~ $op ~ ' does not exist.'); return; }
+    };
+
+=begin
+=item enable()
+
+Inserts the hooks into the interpreter.
+This should only be called after attaching to an Instrument object.
+eg,
+    instr_obj = new ['Instrument']
+    instr_obj.'attach'(probe)
+    
+Additionally, attach will call this method automatically.
+
+=cut
+=end
+
+    method enable () {
+        if !pir::defined__IP($!identifier) { $!identifier := get_id(); }
+        if !pir::defined__IP($!instr_obj) {
+            pir::die('Probe has not been attached to an Instrument object.');
+        }
+        
+        if !$!is_enabled {
+            if $!is_catchall {
+                # Attach a catchall hook.
+                $!instr_obj.insert_op_catchall($!identifier, $!callback);
+            } else {
+                # Attach a hook to each op in @!oplist.
+                for $!oplist {
+                    $!instr_obj.insert_op_hook($!identifier, $_, $!callback);
+                }
+            }
+            
+            $!is_enabled := 1;
+        }
+    };
+
+=begin
+=item disable()
+
+Remove the hooks from the interpreter.
+This should only be called after attaching to an Instrument object.
+eg,
+    instr_obj = new ['Instrument']
+    instr_obj.'attach'(probe)
+    
+You can dynamically attach and remove hooks dynamically.
+
+=cut
+=end
+    
+    method disable () {
+        if !pir::defined__IP($!identifier) { $!identifier := get_id(); }
+        if !pir::defined__IP($!instr_obj) {
+            pir::die('Probe has not been attached to an Instrument object.');
+        }
+        
+        if $!is_enabled {
+            if $!is_catchall {
+                # Attach a catchall hook.
+                $!instr_obj.remove_op_catchall($!identifier);
+            } else {
+                # Attach a hook to each op in @!oplist.
+                for $!oplist {
+                    $!instr_obj.remove_op_hook($!identifier, $_);
+                }
+            }
+            
+            $!is_enabled := 0;
+        }
+    };
+
+    # Helper sub: returns the next available probe id.
+    sub get_id () {
+        if !$id_count { $id_count := 0; }
+        my $id := $id_count++;
+        return "Probe-" ~ $id;
+    };
+    
+    # Helper sub: returns the Sub PMC object of a given sub name.
+    sub get_sub_obj ($sub) {
+        my $type := pir::typeof__PP($sub);
+        
+        if ($type eq 'String') {
+            my $lookup;
+            
+            # Lookup the sub in the 3 namespaces.
+            $lookup := pir::get_global__PS($sub);
+            if !pir::defined__IP($lookup) {
+                $lookup := pir::get_hll_global__PS($sub);
+            }
+            if !pir::defined__IP($lookup) {
+                $lookup := pir::get_root_global__PS($sub);
+            }
+            
+            if !pir::defined__IP($lookup) {
+                pir::die('Could not find sub ' ~ $sub ~ ' in the namespaces.');
+            }
+            
+            $sub := $lookup;
+        }
+        
+        # Ensure that $sub is of type 'Sub'.
+        $type := pir::typeof__PP($sub);
+        if $type ne 'Sub' {
+            pir::die('Type of $sub is not "Sub" but ' ~ $type ~ ' instead.');
+        }
+        
+        return $sub;
+    };
+
+};
+
+# vim: ft=perl6 expandtab shiftwidth=4:

Deleted: branches/gsoc_instrument/runtime/parrot/library/Instrument/Probe.pir
==============================================================================
--- branches/gsoc_instrument/runtime/parrot/library/Instrument/Probe.pir	Fri May 28 15:29:38 2010	(r47092)
+++ /dev/null	00:00:00 1970	(deleted)
@@ -1,640 +0,0 @@
-# Copyright (C) 2010, Parrot Foundation.
-# $Id$
-
-=head1 NAME
-
-runtime/parrot/library/Instrument/Probe.pir - A class to automate the task of creating probes for instruments.
-
-=head1 SYNOPSIS
-
-    # Create a catchall probe which will be called for
-    #  each op.
-    probe = new ['Instrument';'Probe';'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')
-
-=head2 TODO
-1. Rewrite in NQP
-
-=cut
-
-
-=head2 Class Instrument;Probe
-
-Class Instrument;Probe creates a probe who's callback will be called
-when the specified ops are encountered during execution.
-
-=cut
-.namespace ['Instrument';'Probe']
-
-.sub '' :anon :init :load
-    .local pmc class
-
-    class = newclass ['Instrument';'Probe']
-    addattribute class, 'instr_obj'
-    addattribute class, 'callback'
-    addattribute class, 'ops_unprocessed'
-    addattribute class, 'ops_processed'
-    addattribute class, 'enabled'
-    addattribute class, 'finalize'
-
-    .return()
-.end
-
-=item init
-
-=cut
-
-.sub 'init' :vtable :method
-    .local pmc instr_pmc, callback, ops_u, ops_p, enabled
-
-    # Probe is still unattached to an Instrument object.
-    # This attribute will be set by the Instrument object
-    #  when the probe is attached to it.
-    instr_pmc = new ['Undef']
-    setattribute self, 'instr_obj', instr_pmc
-    
-    # Callback is still undefined.
-    callback = new ['Undef']
-    setattribute self, 'callback', callback
-    
-    # Ops is an empty Hash
-    ops_u = new ['Hash']
-    ops_p = new ['Hash']
-    setattribute self, 'ops_unprocessed', ops_u
-    setattribute self, 'ops_processed', ops_p
-    
-    # Enabled is a Boolean.
-    # Each probe is initially disabled
-    enabled = new ['Boolean']
-    enabled = 0
-    setattribute self, 'enabled', enabled
-
-.end
-
-=item inspect
-
-=cut
-
-.sub 'inspect' :method
-    .param pmc ops
-    .local pmc ops_attr
-    ops_attr = getattribute self, 'ops_unprocessed'
-    
-    # ops can be either:
-    # 1. String : Identify an op through a string.
-    # 2. Integer: Identify an op through the op number.
-    # 3. ResizableIntegerArray: A group of op numbers.
-    # 4. ResizableStringArray: A group of op names.
-    #
-    # Anything other than these types are rejected.
-    .local string type
-    type = typeof ops
-
-    if type == 'String' goto T_STR
-    if type == 'Integer' goto T_INT
-    if type == 'ResizableIntegerArray' goto T_ARR
-    if type == 'ResizableStringArray' goto T_ARR
-    
-    # If we get here, it is an unknown type.
-    # Throw an exception.
-    .local pmc ex
-    .local string msg
-    msg = 'Unknown type: '
-    msg .= type
-    
-    ex = new ['Exception']
-    ex = msg
-    throw ex
-
-T_STR:
-T_INT:
-    # Given either the op name or the op number,
-    #  we do nothing other than stashing it into
-    #  the ops attribute. When the probe is enabled,
-    #  the ops attribute is inspected and hooks are
-    #  inserted based on the contents of that hash.
-    # Each entry into the hash is simply given a boolean
-    #  value.
-    # Validation of the op's name or number is done
-    #  when the probe is enabled.
-    ops_attr[ops] = 1
-    .return()
-
-T_ARR:
-    # Iterate through the array and stash the current
-    #  value into the ops_attr hash.
-    .local pmc it, cur
-    it = iter ops
-    
-T_ARR_BEG:
-
-    unless it goto T_ARR_END
-    
-    cur = shift it
-    ops_attr[cur] = 1
-
-    goto T_ARR_BEG
-    
-T_ARR_END:
-    .return()
-
-.end
-
-=item set_callback
-
-=cut
-
-.sub 'set_callback' :method
-    .param pmc sub
-    .local pmc ex
-    .local string msg
-    # If sub is of type string, we need to lookup
-    #  the symbol in the namespace.
-    .local string type
-
-CHECK:
-    type = typeof sub
-        
-    if type == 'String' goto LOOKUP
-    if type == 'Sub' goto SET
-    
-    # If we reached here, we couldn't find the
-    #  symbol or a bad parameter was passed in.
-    msg = 'Unknown type of callback: '
-    msg .= type
-
-EXC:    
-    ex = new ['Exception']
-    ex = msg
-    throw ex
-
-LOOKUP:
-    # Lookup the symbol in the namespace
-    # (Not sure if this is foolproof)
-    .local string name
-    name = sub
-    
-    # Try relative namespace
-    sub = get_global name
-    $I0 = defined sub
-    if $I0 goto CHECK
-    
-    # Try HLL namespace
-    sub = get_hll_global name
-    $I0 = defined sub
-    if $I0 goto CHECK
-    
-    # Try root namespace
-    sub = get_root_global name
-    $I0 = defined sub
-    if $I0 goto CHECK
-
-    # Cannot find the symbol!
-    msg = 'Could not find symbol '
-    msg .= name
-    msg .= '.'
-    
-    goto EXC
-
-SET:
-    # Set the attribute callback and return.
-    setattribute self, 'callback', sub
-    .return()
-.end
-
-=item set_finalize
-
-=cut
-
-.sub 'set_finalize' :method
-    .param pmc sub
-    .local pmc ex
-    .local string msg
-    # If sub is of type string, we need to lookup
-    #  the symbol in the namespace.
-    .local string type
-
-CHECK:
-    type = typeof sub
-        
-    if type == 'String' goto LOOKUP
-    if type == 'Sub' goto SET
-    
-    # If we reached here, we couldn't find the
-    #  symbol or a bad parameter was passed in.
-    msg = 'Unknown type of callback: '
-    msg .= type
-
-EXC:    
-    ex = new ['Exception']
-    ex = msg
-    throw ex
-
-LOOKUP:
-    # Lookup the symbol in the namespace
-    # (Not sure if this is foolproof)
-    .local string name
-    name = sub
-    
-    # Try relative namespace
-    sub = get_global name
-    $I0 = defined sub
-    if $I0 goto CHECK
-    
-    # Try HLL namespace
-    sub = get_hll_global name
-    $I0 = defined sub
-    if $I0 goto CHECK
-    
-    # Try root namespace
-    sub = get_root_global name
-    $I0 = defined sub
-    if $I0 goto CHECK
-
-    # Cannot find the symbol!
-    msg = 'Could not find symbol '
-    msg .= name
-    msg .= '.'
-    
-    goto EXC
-
-SET:
-    # Set the attribute callback and return.
-    setattribute self, 'finalize', sub
-    .return()
-.end
-
-=item enable
-
-=cut
-
-.sub 'enable' :method
-    .local pmc instr_attr, ops_u_attr, ops_p_attr, en_attr, cb_attr
-    .local pmc it, key, op_lib, op_eh
-    .local string msg, type, op_name
-    .local int op_num
-
-    instr_attr = getattribute self, 'instr_obj'
-    ops_u_attr = getattribute self, 'ops_unprocessed'
-    ops_p_attr = getattribute self, 'ops_processed'
-    en_attr    = getattribute self, 'enabled'
-    cb_attr    = getattribute self, 'callback'
-    
-    op_lib     = new ['OpLib']
-    
-    # Check to see if we are already enabled.
-    if en_attr == 1 goto ENABLE_DONE
-    
-    # Check to see if the instr_pmc attribute
-    #  has been set. if not we cannot do anything.
-    msg  = 'Probe is not attached to an Instrument. Could not enable'
-    type = typeof instr_attr
-    
-    if type != 'Instrument' goto EXCEP
-    
-    # Create a new exception handler for op lookups
-    op_eh = new ['ExceptionHandler']
-    set_addr op_eh, NON_EXISTENT_OP
-    push_eh op_eh
-    
-    # Process the unprocessed ops in ops_u_attr.
-    
-    # Because we simply dump in both integers
-    #  and string into the hash, first we get
-    #  the key from the iterator, then we force
-    #  it to be a string, then we try to convert it
-    #  to an integer.
-    # If it fails to get converted into an integer,
-    #  op_num will be 0. Check if op_num == 0, then we
-    #  need to lookup the name by querying instr_attr.
-
-    it = iter ops_u_attr
-
-UNPROC_BEG:
-    unless it goto UNPROC_DONE
-    
-    key = shift it
-    op_name = key
-    op_num  = op_name
-    
-UNPROC_CHECK:
-    # Check if the op is really 0
-    if op_num == 0 goto OPS_LOOKUP
-
-    # If we can convert op_name to op_num, that means that
-    #  the op passed was by number. So we do not need to care
-    #  about variants.
-    # Put this op into the processed hash, with the value
-    #  being a reference to the callback pmc.
-    # TODO: Ensure that the value is not duplicated. Check how Hash works.
-    ops_p_attr[op_num] = cb_attr
-  
-UNPROC_LOOKUPED:
-
-    goto UNPROC_BEG
-
-UNPROC_DONE:
-ENABLE_DONE:
-
-    # All unprocessed ops are done at this point.
-    # Pass ops_p_attr to the instrument pmc for hooking.
-    instr_attr.'insert_op_hooks'(ops_p_attr)
-
-    # We are done with enabling.
-    # Set the enabled attribute and return.
-    en_attr = 1
-    setattribute self, 'enabled', en_attr
-    
-    # Pop the op lookup exception handler
-    pop_eh
-    
-    .return()
-    
-
-EXCEP:
-    # Throw an exception with the message
-    #  in msg.
-    .local pmc ex
-    ex = new ['Exception']
-    ex = msg
-    throw ex
-
-OPS_LOOKUP:
-    # Lookup the op number from op_name
-    # This will return an array, so for each element
-    #  in the array, insert it into ops_p_attr.
-    .local pmc query_ret, op_lu_it, op_lu_cur, op_obj
-
-    query_ret = op_lib.'op_family'(op_name)
-    $I0 = defined query_ret
-    if $I0 goto OPS_LOOKUP_ITER
-    
-    # Not short name.
-    op_obj = op_lib[op_name]
-    query_ret = new ['ResizablePMCArray']
-    push query_ret, op_obj
-    
-OPS_LOOKUP_ITER:
-    op_lu_it = iter query_ret
-
-OPS_LOOKUP_BEG:
-    unless op_lu_it goto OPS_LOOKUP_END
-
-    op_lu_cur = shift op_lu_it
-    op_num = op_lu_cur
-    
-    ops_p_attr[op_num] = cb_attr
-    
-    goto OPS_LOOKUP_BEG
-
-OPS_LOOKUP_END:
-
-    goto UNPROC_LOOKUPED
-    
-NON_EXISTENT_OP:
-    print 'Warning: Non-existant op "'
-    print op_name
-    say '".'
-    
-    goto OPS_LOOKUP_END
-    
-.end
-
-=item disable
-
-=cut
-
-.sub 'disable' :method
-.end
-
-
-=head2 Class Instrument;Probe;Catchall
-
-Class Instrument;Probe;Catchall creates a probe who's callback is called
-for all ops encountered during execution
-
-=cut
-
-.namespace ['Instrument';'Probe';'Catchall']
-
-.sub '' :anon :init :load
-    .local pmc class
-
-    class = newclass ['Instrument';'Probe';'Catchall']
-    addattribute class, 'instr_obj'
-    addattribute class, 'callback'
-    addattribute class, 'enabled'
-    addattribute class, 'finalize'
-
-    .return()
-.end
-
-=item init
-
-=cut
-
-.sub 'init' :vtable :method
-    .local pmc instr_pmc, callback, ops_u, ops_p, enabled
-
-    # Probe is still unattached to an Instrument object.
-    # This attribute will be set by the Instrument object
-    #  when the probe is attached to it.
-    instr_pmc = new ['Undef']
-    setattribute self, 'instr_obj', instr_pmc
-    
-    # Callback is still undefined.
-    callback = new ['Undef']
-    setattribute self, 'callback', callback
-    
-    # Enabled is a Boolean.
-    # Each probe is initially disabled
-    enabled = new ['Boolean']
-    enabled = 0
-    setattribute self, 'enabled', enabled
-
-.end
-
-=item set_callback
-
-=cut
-
-.sub 'set_callback' :method
-    .param pmc sub
-    .local pmc ex
-    .local string msg
-    # If sub is of type string, we need to lookup
-    #  the symbol in the namespace.
-    .local string type
-
-CHECK:
-    type = typeof sub
-        
-    if type == 'String' goto LOOKUP
-    if type == 'Sub' goto SET
-    
-    # If we reached here, we couldn't find the
-    #  symbol or a bad parameter was passed in.
-    msg = 'Unknown type of callback: '
-    msg .= type
-
-EXC:    
-    ex = new ['Exception']
-    ex = msg
-    throw ex
-
-LOOKUP:
-    # Lookup the symbol in the namespace
-    # (Not sure if this is foolproof)
-    .local string name
-    name = sub
-    
-    # Try relative namespace
-    sub = get_global name
-    $I0 = defined sub
-    if $I0 goto CHECK
-    
-    # Try HLL namespace
-    sub = get_hll_global name
-    $I0 = defined sub
-    if $I0 goto CHECK
-    
-    # Try root namespace
-    sub = get_root_global name
-    $I0 = defined sub
-    if $I0 goto CHECK
-
-    # Cannot find the symbol!
-    msg = 'Could not find symbol '
-    msg .= name
-    msg .= '.'
-    
-    goto EXC
-
-SET:
-    # Set the attribute callback and return.
-    setattribute self, 'callback', sub
-    .return()
-.end
-
-=item set_finalize
-
-=cut
-
-.sub 'set_finalize' :method
-    .param pmc sub
-    .local pmc ex
-    .local string msg
-    # If sub is of type string, we need to lookup
-    #  the symbol in the namespace.
-    .local string type
-
-CHECK:
-    type = typeof sub
-        
-    if type == 'String' goto LOOKUP
-    if type == 'Sub' goto SET
-    
-    # If we reached here, we couldn't find the
-    #  symbol or a bad parameter was passed in.
-    msg = 'Unknown type of callback: '
-    msg .= type
-
-EXC:    
-    ex = new ['Exception']
-    ex = msg
-    throw ex
-
-LOOKUP:
-    # Lookup the symbol in the namespace
-    # (Not sure if this is foolproof)
-    .local string name
-    name = sub
-    
-    # Try relative namespace
-    sub = get_global name
-    $I0 = defined sub
-    if $I0 goto CHECK
-    
-    # Try HLL namespace
-    sub = get_hll_global name
-    $I0 = defined sub
-    if $I0 goto CHECK
-    
-    # Try root namespace
-    sub = get_root_global name
-    $I0 = defined sub
-    if $I0 goto CHECK
-
-    # Cannot find the symbol!
-    msg = 'Could not find symbol '
-    msg .= name
-    msg .= '.'
-    
-    goto EXC
-
-SET:
-    # Set the attribute callback and return.
-    setattribute self, 'finalize', sub
-    .return()
-.end
-
-=item enable
-
-=cut
-
-.sub 'enable' :method
-    .local pmc instr_attr, en_attr, cb_attr
-    .local string msg, type
-
-    instr_attr = getattribute self, 'instr_obj'
-    en_attr    = getattribute self, 'enabled'
-    cb_attr    = getattribute self, 'callback'
-    
-    # Check to see if we are already enabled.
-    if en_attr == 1 goto ENABLE_DONE
-    
-    # Check to see if the instr_pmc attribute
-    #  has been set. if not we cannot do anything.
-    msg  = 'Probe is not attached to an Instrument. Could not enable'
-    type = typeof instr_attr
-    
-    if type != 'Instrument' goto EXCEP
-    
-ENABLE_DONE:
-
-    # Catchall hooks are treated separate from specific hooks.
-    # They are called first too.
-    instr_attr.'insert_op_catchall'(cb_attr)
-
-    # We are done with enabling.
-    # Set the enabled attribute and return.
-    en_attr = 1
-    setattribute self, 'enabled', en_attr
-    
-    .return()
-    
-
-EXCEP:
-    # Throw an exception with the message
-    #  in msg.
-    .local pmc ex
-    ex = new ['Exception']
-    ex = msg
-    throw ex
-    
-.end
-
-# Local Variables:
-#   mode: pir
-#   fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:

Modified: branches/gsoc_instrument/src/dynpmc/instrument.pmc
==============================================================================
--- branches/gsoc_instrument/src/dynpmc/instrument.pmc	Fri May 28 15:25:07 2010	(r47092)
+++ branches/gsoc_instrument/src/dynpmc/instrument.pmc	Fri May 28 15:29:38 2010	(r47093)
@@ -83,8 +83,8 @@
         attr->supervisor  = INTERP;
         attr->supervised  = Parrot_new(attr->supervisor);
         attr->op_hooks    = Parrot_pmc_new(INTERP, enum_class_ResizablePMCArray);
-        attr->op_catchall = Parrot_pmc_new(INTERP, enum_class_ResizablePMCArray);
-        attr->probes      = Parrot_pmc_new(INTERP, enum_class_ResizablePMCArray);
+        attr->op_catchall = Parrot_pmc_new(INTERP, enum_class_Hash);
+        attr->probes      = Parrot_pmc_new(INTERP, enum_class_Hash);
         
         /* Initialize the runcore for the child interpreter */  
         Instrument_runcore_init(attr->supervised, SELF);
@@ -166,8 +166,7 @@
 
     VTABLE void set_pointer (void *pc_pointer) {
         opcode_t *pc = (opcode_t *) pc_pointer;
-        INTVAL hook_count, cur_hook, catchall_count, cur_catchall;
-        PMC *hooks;
+        PMC *hooks, *hook_iter, *catchall_iter;
         Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
         STRING *full_name;
         
@@ -175,27 +174,29 @@
         full_name = CONST_STRING(INTERP, attr->supervised->op_info_table[*pc].full_name);
         
         /* Fire the catchall hooks first */
-        catchall_count = VTABLE_get_integer(INTERP, attr->op_catchall);
-        for(cur_catchall = 0; cur_catchall < catchall_count; cur_catchall++) {
-            PMC *cur_catchall_sub;
-            
-            cur_catchall_sub = VTABLE_get_pmc_keyed_int(INTERP, attr->op_catchall,
-                                                    cur_catchall);
-            if(!PMC_IS_NULL(cur_catchall_sub)) 
-                Parrot_ext_call(INTERP, cur_catchall_sub, "S->", full_name);
+        catchall_iter = VTABLE_get_iter(INTERP, attr->op_catchall);
+        while(VTABLE_get_bool(INTERP, catchall_iter)) {
+            PMC *val, *key;
+            
+            key = VTABLE_shift_pmc(INTERP, catchall_iter);
+            val = VTABLE_get_pmc_keyed(INTERP, attr->op_catchall, key);
+            
+            if(!PMC_IS_NULL(val)) 
+                Parrot_ext_call(INTERP, val, "S->", full_name);
         }
         
         /* Fire the specific probes */
-        hooks = VTABLE_get_pmc_keyed_int(INTERP, attr->op_hooks, *pc);
+        hooks     = VTABLE_get_pmc_keyed_int(INTERP, attr->op_hooks, *pc);
         if(!PMC_IS_NULL(hooks)) {
-        
-            hook_count = VTABLE_get_integer(INTERP, hooks);
-            for(cur_hook = 0; cur_hook < hook_count; cur_hook++) {
-                PMC *cur_hook_sub;
+            hook_iter = VTABLE_get_iter(INTERP, hooks);
+            while(VTABLE_get_bool(INTERP, hook_iter)) {
+                PMC *val, *key;
+                
+                key = VTABLE_shift_pmc(INTERP, hook_iter);
+                val = VTABLE_get_pmc_keyed(INTERP, hooks, key);
                 
-                cur_hook_sub = VTABLE_get_pmc_keyed_int(INTERP, hooks, cur_hook);
-                if(!PMC_IS_NULL(cur_hook_sub)) 
-                    Parrot_ext_call(INTERP, cur_hook_sub, "S->", full_name);
+                if(!PMC_IS_NULL(val)) 
+                    Parrot_ext_call(INTERP, val, "S->", full_name);
             }
         }
         
@@ -220,6 +221,7 @@
         char ** argv = default_argv;
         Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
         PMC *probe_iter;
+        int counter = 0;
             
         /* If args is not null, is of type ResizableStringArray and has at
            least 1 element, process it so we can pass it to the child interpreter.
@@ -260,12 +262,13 @@
         /* Finalize the instruments */
         probe_iter = VTABLE_get_iter(INTERP, attr->probes);
         while(VTABLE_get_bool(INTERP, probe_iter)) {
-            PMC *cur_probe, *finalize_sub;
+            PMC *key, *probe, *finalize_sub;
             
             /* For the current probe, get the finalize attribute. */
-            cur_probe = VTABLE_shift_pmc(INTERP, probe_iter);
-            finalize_sub = VTABLE_get_attr_str(INTERP, cur_probe,
-                                               CONST_STRING(INTERP, "finalize"));
+            key          = VTABLE_shift_pmc(INTERP, probe_iter);
+            probe        = VTABLE_get_pmc_keyed(INTERP, attr->probes, key);
+            finalize_sub = VTABLE_get_attr_str(INTERP, probe,
+                                               CONST_STRING(INTERP, "$!finalize"));
             
             /* If it is set, call that sub. */
             if(!PMC_IS_NULL(finalize_sub)) {
@@ -299,18 +302,18 @@
 */
 
     METHOD attach (PMC *obj) {
-        PMC *enable_method;
+        PMC *enable_method, *id;
         Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
     
         /* We do not care what type of object it is,
-           as long as the object has the attribute instr_obj and
-           the method enable. */
+           as long as the object has the attributes $!instr_obj and $!identifier
+           and the method enable. */
         
         /* Set the instrument reference attribute of the object,
            and call its enable method. */
         VTABLE_set_attr_str(
             INTERP, obj,
-            CONST_STRING(INTERP, "instr_obj"),
+            CONST_STRING(INTERP, "$!instr_obj"),
             SELF
         );
         
@@ -330,60 +333,81 @@
         Parrot_ext_call(INTERP, enable_method, "P->", obj);
         
         /* Register the probe. */
-        VTABLE_push_pmc(INTERP, attr->probes, obj);
+        id = VTABLE_get_attr_str(INTERP, obj, CONST_STRING(INTERP, "$!identifier"));
+        VTABLE_set_pmc_keyed(INTERP, attr->probes, id, obj);
     }
 
 /*
 
-=item C<void *insert_op_hooks(PMC *hook_hash)>
+=item C<void *insert_op_hooks(PMC *id, INTVAL op_num, PMC *hook)>
 
-Insert hooks based on what is given in hook_hash.
-Keys are op numbers and values are sub pmcs.
+Insert a hook for the given op number.
 
 =cut
 
 */
+    
+    METHOD insert_op_hook (PMC *id, INTVAL op_num, PMC *hook) {
+        PMC *op_num_hooks;
+        Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
+        
+        op_num_hooks = VTABLE_get_pmc_keyed_int(INTERP, attr->op_hooks, op_num);
+        if(PMC_IS_NULL(op_num_hooks)) {
+            op_num_hooks = Parrot_pmc_new(INTERP, enum_class_Hash);
+            VTABLE_set_pmc_keyed_int(INTERP, attr->op_hooks, op_num, op_num_hooks);
+        }
+        
+        VTABLE_set_pmc_keyed(INTERP, op_num_hooks, id, hook);
+    }
+
+/*
+
+=item C<void *remove_op_hooks(PMC *id, INTVAL op_num)>
+
+Removes a hook for the given op number.
+
+=cut
 
-    METHOD insert_op_hooks (PMC *hook_hash) {
-        PMC *iter;
+*/
+    
+    METHOD remove_op_hook (PMC *id, INTVAL op_num) {
+        PMC *op_num_hooks;
         Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
         
-        /* Iterate through hook_hash. For each
-           key (op_num), push the callback to the
-           appropriate entry in op_hooks. */
-        iter = VTABLE_get_iter(INTERP, hook_hash);
-        while(VTABLE_get_bool(INTERP, iter)) {
-            INTVAL op_num;
-            PMC *iter_key, *cur, *callback, *op_num_hooks;
-            
-            iter_key = VTABLE_shift_pmc(INTERP, iter);
-            cur      = VTABLE_get_pmc(INTERP, iter_key);
-            op_num   = VTABLE_get_integer(INTERP, cur);
-            callback = VTABLE_get_pmc_keyed(INTERP, hook_hash, cur);
-            
-            op_num_hooks = VTABLE_get_pmc_keyed_int(INTERP, attr->op_hooks, op_num);
-            if(PMC_IS_NULL(op_num_hooks)) {
-                op_num_hooks = Parrot_pmc_new(INTERP, enum_class_ResizablePMCArray);
-                VTABLE_set_pmc_keyed_int(INTERP, attr->op_hooks, op_num, op_num_hooks);
-            }
-            
-            VTABLE_push_pmc(INTERP, op_num_hooks, callback);
+        op_num_hooks = VTABLE_get_pmc_keyed_int(INTERP, attr->op_hooks, op_num);
+        if(!PMC_IS_NULL(op_num_hooks)) {
+            VTABLE_delete_keyed(INTERP, op_num_hooks, id);
         }
     }
 
 /*
-=item C<void *insert_op_catchall(PMC *callback)>
+=item C<void *insert_op_catchall(PMC *id, PMC *callback)>
 
 Register a catchall op callback
 
 =cut
 */
 
-    METHOD insert_op_catchall (PMC *callback) {
+    METHOD insert_op_catchall (PMC *id, PMC *callback) {
         Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
         
-        VTABLE_push_pmc(INTERP, attr->op_catchall, callback);
+        VTABLE_set_pmc_keyed(INTERP, attr->op_catchall, id, callback);
     }
+
+/*
+=item C<void *remove_op_catchall(PMC *id)>
+
+Deregister a catchall op callback
+
+=cut
+*/
+
+    METHOD remove_op_catchall (PMC *id) {
+        Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
+        
+        VTABLE_delete_keyed(INTERP, attr->op_catchall, id);
+    }
+
 }
 
 /*

Modified: branches/gsoc_instrument/t/dynpmc/instrument.t
==============================================================================
--- branches/gsoc_instrument/t/dynpmc/instrument.t	Fri May 28 15:25:07 2010	(r47092)
+++ branches/gsoc_instrument/t/dynpmc/instrument.t	Fri May 28 15:29:38 2010	(r47093)
@@ -48,26 +48,32 @@
 .end
 
 .sub 'test_attach'    
-    .local pmc mock_probe, instr
+    .local pmc mock_probe, mock_id, instr
     .local pmc class, enable_method, ins, it, type
-
-    class = newclass ['MockProbe']
-    addattribute class, 'instr_obj'
     
-    mock_probe = new class
-    instr      = new ['Instrument']
+    mock_id    = box 'MockProbe-0'
+    mock_probe = new ['MockProbe']
+    setattribute mock_probe, '$!identifier', mock_id
     
+    instr      = new ['Instrument']
     instr.'attach'(mock_probe)
     
 .end
 
 .namespace ['MockProbe']
+.sub '' :anon :init :load
+    .local pmc class
+    class = newclass ['MockProbe']
+    addattribute class, '$!instr_obj'
+    addattribute class, '$!identifier'
+.end
+
 .sub 'enable' :method
     ok(1, 'Enable is called')
     
     .local pmc instr_obj
     .local string instr_obj_type
-    instr_obj = getattribute self, 'instr_obj'
+    instr_obj = getattribute self, '$!instr_obj'
     $I0 = defined instr_obj
     ok($I0, 'Attribute instr_obj is defined')
     


More information about the parrot-commits mailing list