Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Repurposed this repository as the new Instruments repository. Copied …

…relevant files from HEAD of gsoc_instrument branch.
  • Loading branch information...
commit af9763823c2d3f38dffbcaa0d0ff23080446aea1 1 parent 8e8e14e
@khairulsyamil authored
View
116 doctor.c
@@ -1,116 +0,0 @@
-#include <parrot/parrot.h>
-#include <parrot/embed.h>
-#include <parrot/extend.h>
-#include <parrot/runcore_api.h>
-#include <parrot/imcc.h>
-
-//Prototypes
-static opcode_t *
-runops_instr_core(Parrot_Interp interp, Parrot_runcore_t *runcore, opcode_t *pc);
-
-//Instrument registry.
-typedef struct _instrument_pmc_table {
- Parrot_PMC init; // Called before executing code.
- Parrot_PMC exit; // Called after code executes.
- Parrot_PMC counter; // Called by the runcore.
-} Instr_pmc_table;
-
-//Globals.
-Parrot_Interp code_interp, instruments_interp;
-Instr_pmc_table tb = {0}; // I think PMCs are pointers. So setting it to NULL should be ok right?
-
-int main (int argc, char ** argv) {
- Parrot_String str;
-
- //Initialise both interpreters.
- instruments_interp = Parrot_new(NULL);
- code_interp = Parrot_new(instruments_interp);
-
- //Initialise imcc for both interpreters.
- imcc_initialize(instruments_interp);
- imcc_initialize(code_interp);
-
- imcc_start_handling_flags(instruments_interp);
- imcc_start_handling_flags(code_interp);
-
- //Assert that both interpreters initialized correctly.
- //... Later
-
- /* How to hijack the runcore of a?
- * Looking at cores.c, the slow core is the simplest.
- * So we shall ensure that the code interpreter initialises
- * that core.
- *
- * With the runcore_t set, simply changing the function pointer
- * for the runcore should do the trick.
- *
- * It is not a good thing to do, but I don't want to recreate
- * a runcore for now. For the proof of concept, all I want to
- * do is intercept the instruction before it is executed.
- */
- Parrot_set_run_core(code_interp, PARROT_SLOW_CORE); // <- Set to slow core.
- code_interp->run_core->runops = runops_instr_core; // <- Then we hijack.
-
- /* Now that both interpreters are initialized,
- * its time to load up the files.
- *
- * Keep it simple for now.
- * argv[1] = instruments
- * argv[2] = source code
- */
-
- //Load up the instruments.
- imcc_run(instruments_interp, argv[1], 1, argv + 1);
-
- //Scan the instruments.
- // (So far I only have instruction counter)
- str = string_from_literal(instruments_interp, "instr_init");
- tb.init = Parrot_find_global_cur(instruments_interp, str);
- str = string_from_literal(instruments_interp, "instr_exit");
- tb.exit = Parrot_find_global_cur(instruments_interp, str);
- str = string_from_literal(instruments_interp, "instr_instruction_counter");
- tb.counter = Parrot_find_global_cur(instruments_interp, str);
-
- //Load up the code and run.
- imcc_run(code_interp, argv[2], argc - 2, argv + 2);
-
- //Ask the instruments to report.
- Parrot_ext_call(instruments_interp, tb.exit, "->");
-
- //Done.
- Parrot_destroy(code_interp);
- Parrot_destroy(instruments_interp);
-
- return 0;
-}
-
-static opcode_t *
-runops_instr_core(Parrot_Interp interp, Parrot_runcore_t *runcore, opcode_t *pc) {
-
- while (pc) {
- /*if (pc < code_start || pc >= code_end)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "attempt to access code outside of current code segment");*/
- // ^ where does code_start and code_end come from?
-
- Parrot_pcc_set_pc(interp, CURRENT_CONTEXT(interp), pc);
-
- //Dispatch the instruments.
- // Well, for now we just have 1 instrument.
- Parrot_ext_call(
- instruments_interp,
- tb.counter,
- "S->",
- Parrot_str_new(
- instruments_interp,
- interp->op_info_table[*pc].full_name,
- 0
- )
- );
- //printf("Doctor: Instruction == %s\n", interp->op_info_table[*pc].full_name);
-
- DO_OP(pc, interp);
- }
-
- return pc;
-}
View
154 examples/tracer.nqp
@@ -0,0 +1,154 @@
+# Copyright (C) 2010, Parrot Foundation.
+# $Id: tracer.nqp 48347 2010-08-08 16:36:50Z khairul $
+
+=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 $instr := pir::new__PS('Instrument');
+
+my $probe := $instr.instrument_op();
+$probe.catchall(1);
+$probe.callback('tracer');
+
+
+$instr.attach($probe);
+$instr.run(@args[0], @args);
+
+##
+# Callback that is called by Instrument.
+##
+sub tracer ($op, $instr_obj, $probe) {
+ my $pc_hex := pir::sprintf__SSP("%04x", [$op.pc()]);
+ my $op_name := $op.family();
+ my $param_cnt := $op.count();
+ my $params := '';
+ my $cur_arg := 0;
+
+ my @arg_list := ();
+ while $cur_arg < $param_cnt {
+ # Evaluate in order of:
+ # 1. keys
+ # 2. constants
+ # 3. regs.
+ my $arg_str := try_key($op, $cur_arg, @arg_list)
+ // try_constant($op, $cur_arg)
+ // try_register($op, $cur_arg);
+
+ @arg_list.push($arg_str);
+ $cur_arg++;
+ }
+
+ $params := pir::join__SSP(', ', @arg_list);
+ say($pc_hex ~ ' ' ~ $op_name ~ ' ' ~ $params);
+};
+
+##
+# Try to evaluate current argument as a key.
+##
+sub try_key($op, $cur_arg, @arg_list) {
+ my $arg_type := $op.arg_type($cur_arg);
+ my $arg := $op.get_arg($cur_arg, 1);
+ my $arg_str;
+
+ # Keys have the flag 0x20 set.
+ if and($arg_type, 0x20) {
+ if and($arg_type, 16) {
+ # Constant keys are int constants or strings.
+ $arg_str := '[' ~ try_constant($op, $cur_arg) ~ ']';
+ }
+ else {
+ # Non-constant keys. Reference regs only.
+ $arg_str := '[' ~ try_register($op, $cur_arg) ~ ']';
+ }
+
+ my $prev := @arg_list.pop();
+ $arg_str := $prev ~ $arg_str;
+ }
+
+ return $arg_str;
+}
+
+##
+# Try to evaluate current argument as a constant.
+##
+sub try_constant($op, $cur_arg) {
+ my $arg_type := $op.arg_type($cur_arg);
+ my $arg := $op.get_arg($cur_arg, 1);
+ my $arg_str;
+
+ if and($arg_type, 16) {
+ if and($arg_type, 1) {
+ # String constant.
+ $arg_str := '"' ~ pir::escape__SS($op.get_arg($cur_arg)) ~ '"';
+ }
+ elsif and($arg_type, 2) {
+ # PMC constant.
+ $arg_str := 'PC' ~ $arg;
+ }
+ else {
+ # Either integer or float constant.
+ $arg_str := $arg;
+ }
+ }
+
+ return $arg_str;
+}
+
+##
+# Try to evaluate current argument as a register.
+##
+sub try_register($op, $cur_arg) {
+ my $arg_type := $op.arg_type($cur_arg);
+ my $arg := $op.get_arg($cur_arg, 1);
+ my $arg_str;
+
+ # Assume $arg is a register.
+ if !$arg_type {
+ # 0 is int reg.
+ $arg_str := 'I' ~ $arg;
+ }
+ elsif and($arg_type, 1) {
+ # 1 is string reg.
+ $arg_str := 'S' ~ $arg;
+ }
+ elsif and($arg_type, 2) {
+ # 2 is pmc.
+ $arg_str := 'P' ~ $arg;
+ }
+ elsif and($arg_type, 3) {
+ # 3 is num reg.
+ $arg_str := 'N' ~ $arg;
+ }
+
+ return $arg_str;
+}
+
+##
+# ANDs $a and $b and check that the result is $b.
+##
+sub and($a, $b) {
+ pir::band__III($a, $b) == $b;
+}
+
+# vim: ft=perl6 expandtab shiftwidth=4:
View
61 instr.pir
@@ -1,61 +0,0 @@
-.sub instr_init :main
- .local pmc hash
- $P0 = new 'Integer'
- hash = new ['Hash']
- set_global "$instruction_count", $P0
- set_global "$instruction_hash", hash
-.end
-
-.sub instr_exit
- get_global $P0, "$instruction_count"
- print "Instrumentation Report:\n\n"
- print "\tInstruction Counter : "
- print $P0
- print " instructions counted\n"
- print "\n"
- print "\tIndividual Instruction Counts :\n"
- dump_hash()
-.end
-
-.sub dump_hash
- .local pmc hash
- .local pmc it
- get_global hash, "$instruction_hash"
- it = iter hash
-LOOP: unless it goto L_END
- $P0 = shift it
- $P1 = $P0.'key'()
- $I0 = hash[$P1]
-
- print "\t\t"
- print $P1
- print " : "
- print $I0
- print "\n"
- goto LOOP
-L_END:
-.end
-
-.sub instr_instruction_counter
- .param pmc instr_name
- .local pmc hash
- .local pmc counter
-
- get_global counter, "$instruction_count"
- get_global hash, "$instruction_hash"
-
- # Increment Instruction Count
- counter = counter + 1
-
- # Check if the instruction is defined in hash
- $P0 = hash[instr_name]
- $I0 = defined $P0
- if $I0 goto DEF
- $P0 = new 'Integer'
-DEF:
- $P0 = $P0 + 1
- set hash[instr_name], $P0
-
- set_global "$instruction_count", counter
- set_global "$instruction_hash", hash
-.end
View
890 src/dynpmc/instrument.pmc
@@ -0,0 +1,890 @@
+/*
+Copyright (C) 2010, Parrot Foundation.
+$Id: instrument.pmc 48438 2010-08-12 19:43:40Z khairul $
+
+=head1 NAME
+
+src/dynpmc/instrument.pmc - Instrument
+
+=head1 DESCRIPTION
+
+C<Instrument> is a PMC class that allows dynamic execution introspection
+to be done on a child interpreter.
+
+=head2 Methods
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+#include "parrot/imcc.h"
+#include "parrot/runcore_api.h"
+#include "parrot/embed.h"
+#include "parrot/opsenum.h"
+
+#include "instrument_private.h"
+
+/* Helper prototypes. */
+probe_list_t *fire_callbacks(PARROT_INTERP, probe_list_t *callbacks, PMC *data, PMC *instr);
+PMC *instrument_pack_params(PARROT_INTERP, const char *format, ...);
+
+/* List related prototypes */
+probe_list_t *probe_list_create_list(PARROT_INTERP);
+probe_node_t *probe_list_create_node(PARROT_INTERP);
+void probe_list_delete_list(PARROT_INTERP, probe_list_t *list);
+void probe_list_delete_node(PARROT_INTERP, probe_node_t *node);
+void probe_list_push(PARROT_INTERP, probe_list_t *list, PMC *item);
+PMC *probe_list_pop(PARROT_INTERP, probe_list_t *list);
+PMC *probe_list_remove(PARROT_INTERP, probe_list_t *list, probe_node_t *node);
+probe_node_t *probe_list_find(PARROT_INTERP, probe_list_t *list, PMC *val);
+void probe_list_append(PARROT_INTERP, probe_list_t *dest, probe_list_t *src);
+
+pmclass Instrument auto_attrs dynpmc provides hash group instrument_group {
+ ATTR Parrot_Interp supervised; /* The interpreter running the code */
+ ATTR PMC *probes; /* A list of probes registered. */
+ ATTR PMC *instrument_rc; /* Reference to the InstrumentRuncore object. */
+ ATTR PMC *instrument_gc; /* Reference to the InstrumentGC object. */
+ ATTR Hash *instrument_classes; /* Registry to hold instances of InstrumentClass. */
+ ATTR Hash *instrument_objects; /* Registry of current instrumented objects. */
+ ATTR Hash *event_handlers; /* Reference to registered instrument event handlers. */
+
+/*
+
+=item C<void init()>
+
+Initializes the pmc and creates a child interpreter.
+
+=cut
+
+*/
+
+ VTABLE void init() {
+ Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
+ INTVAL gc_class_type, rc_class_type;
+
+ /* Obtain the class type of InstrumentGC. */
+ gc_class_type = Parrot_pmc_get_type_str(INTERP, CONST_STRING(INTERP, "InstrumentGC"));
+ rc_class_type = Parrot_pmc_get_type_str(INTERP, CONST_STRING(INTERP, "InstrumentRuncore"));
+
+ /* Initialise the attributes. */
+ attr->supervised = Parrot_new(INTERP);
+ attr->probes = Parrot_pmc_new(INTERP, enum_class_Hash);
+ attr->event_handlers = parrot_new_hash(INTERP);
+ attr->instrument_classes = parrot_new_hash(INTERP);
+ attr->instrument_rc = Parrot_pmc_new_init(INTERP, rc_class_type, SELF);
+ attr->instrument_gc = Parrot_pmc_new_init(INTERP, gc_class_type, SELF);
+ attr->instrument_objects = parrot_new_pointer_hash(INTERP);
+
+ /* Initialize the scheduler for the child interpreter */
+ attr->supervised->scheduler = Parrot_pmc_new(interp, enum_class_Scheduler);
+ attr->supervised->scheduler = VTABLE_share_ro(interp, attr->supervised->scheduler);
+
+ /* Set self to destroy manually */
+ PObj_custom_mark_destroy_SETALL(SELF);
+ }
+
+/*
+
+=item C<void destroy()>
+
+Cleans up after the PMC.
+
+=cut
+
+*/
+
+ VTABLE void destroy() {
+ Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
+ Parrot_destroy(attr->supervised);
+ parrot_hash_destroy(INTERP, attr->event_handlers);
+ parrot_hash_destroy(INTERP, attr->instrument_classes);
+ parrot_hash_destroy(INTERP, attr->instrument_objects);
+ }
+
+/*
+
+=item C<void mark()>
+
+Marks internal data structures as live to the gc.
+
+=cut
+
+*/
+
+ VTABLE void mark() {
+ Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
+
+ /* Mark attributes as alive */
+ Parrot_gc_mark_PMC_alive_fun(INTERP, attr->probes);
+ Parrot_gc_mark_PMC_alive_fun(INTERP, attr->instrument_gc);
+ Parrot_gc_mark_PMC_alive_fun(INTERP, attr->instrument_rc);
+ parrot_mark_hash(INTERP, attr->event_handlers);
+ parrot_mark_hash(INTERP, attr->instrument_classes);
+ parrot_mark_hash(INTERP, attr->instrument_objects);
+ }
+
+/*
+
+=item C<void get_pmc_keyed(PMC *key)>
+
+Get the property with the key.
+
+Keys:
+probes : returns the clone of the hash of probes currently registered.
+runcore : returns the InstrumentRuncore instance.
+gc : returns the InstrumentGC instance.
+
+Unknown keys are sent to the supervised interpreter.
+
+=cut
+
+*/
+
+ VTABLE PMC *get_pmc_keyed(PMC *key) {
+ Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
+ PMC *nextkey, *supervised_pmc;
+ STRING *item = key_string(INTERP, key);
+ STRING *name;
+
+ /* probes: return the hash of probes */
+ name = CONST_STRING(INTERP, "probes");
+ if (Parrot_str_equal(INTERP, name, item)) {
+ return VTABLE_clone(INTERP, attr->probes);
+ }
+
+ /* gc: returns the InstrumentGC instance. */
+ name = CONST_STRING(INTERP, "gc");
+ if (Parrot_str_equal(INTERP, name, item)) {
+ return attr->instrument_gc;
+ }
+
+ /* runcore: returns the InstrumentRuncore instance. */
+ name = CONST_STRING(INTERP, "runcore");
+ if (Parrot_str_equal(INTERP, name, item)) {
+ return attr->instrument_rc;
+ }
+
+ /* push to the supervised interpreter. */
+ supervised_pmc = VTABLE_get_pmc_keyed_int(attr->supervised,
+ attr->supervised->iglobals,
+ (INTVAL) IGLOBALS_INTERPRETER);
+ return VTABLE_get_pmc_keyed(INTERP, supervised_pmc, key);
+ }
+
+/*
+
+=item C<void run(STRING file, PMC *args)>
+
+Executes the given file, 'file', in the child interpreter,
+passing the arguments in the form of the array 'args' to the
+program in 'file'.
+
+=cut
+
+*/
+
+ METHOD run(STRING file, PMC *args) {
+ int argc = 0, status;
+ char * default_argv[] = {NULL};
+ char ** argv = default_argv;
+ char * file_c;
+ Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
+ PMC *probe_iter;
+ int counter = 0;
+
+ /* If args is not null, does array and has a size > 0, convert it
+ into a cstring array to pass to imcc.
+ */
+ if (!Parrot_pmc_is_null(INTERP, args)
+ && VTABLE_does(INTERP, args, CONST_STRING(INTERP, "array"))
+ && VTABLE_get_integer(INTERP, args) > 0) {
+
+ /* Get the number of argument values */
+ int count = VTABLE_get_integer(INTERP, args);
+
+ /* Allocate enough memory for the argv pointer array */
+ argv = (char **) mem_gc_allocate_n_zeroed_typed(INTERP, count, char *);
+
+ /* Populate the argv array, updating argc in the process */
+ for (argc = 0; argc < count; argc++) {
+ STRING *cur;
+
+ cur = VTABLE_get_string_keyed_int(INTERP, args, argc);
+ argv[argc] = Parrot_str_to_cstring(INTERP, cur);
+ }
+ }
+
+ /* Begin Execution */
+ file_c = Parrot_str_to_cstring(attr->supervised, file);
+ status = imcc_run(attr->supervised,
+ file_c,
+ argc, (const char **) argv);
+ if (status) {
+ imcc_run_pbc(attr->supervised,
+ attr->supervised->output_file,
+ argc, (const char **) argv);
+ }
+ Parrot_str_free_cstring(file_c);
+
+ /* Finalize the instruments */
+ probe_iter = VTABLE_get_iter(INTERP, attr->probes);
+ while (VTABLE_get_bool(INTERP, probe_iter)) {
+ PMC *key, *probe, *finalize_sub;
+
+ /* For the current probe, get the finalize attribute. */
+ 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)) {
+ Parrot_ext_call(INTERP, finalize_sub, "->");
+ }
+ }
+
+ /* We should free the cstrings allocated above if needed */
+ if (argc > 0) {
+ for (; argc > 0; argc--) {
+ Parrot_str_free_cstring(argv[argc - 1]);
+ argv[argc - 1] = NULL;
+ }
+
+ /* Free the memory allocated to hold the string pointers */
+ mem_gc_free(INTERP, argv);
+ argv = NULL;
+ }
+ }
+
+/*
+
+=item C<void attach(PMC *obj)>
+
+With the passed in object, assume it is a class with the method 'enable'
+and attribute 'instr_obj'. Set the '$!instr_obj' attribute to SELF and call the
+'enable' method of the object for the object to commence attaching the hooks.
+
+=cut
+
+*/
+
+ METHOD attach(PMC *obj) {
+ PMC *id;
+ Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
+
+ STRING *instr_attr = CONST_STRING(INTERP, "$!instr_obj");
+ STRING *id_attr = CONST_STRING(INTERP, "$!identifier");
+ STRING *_on_attach = CONST_STRING(INTERP, "_on_attach");
+
+ VTABLE_set_attr_str(INTERP, obj, instr_attr, SELF);
+ Parrot_pcc_invoke_method_from_c_args(INTERP, obj, _on_attach, "->");
+
+ /* Register the probe. */
+ id = VTABLE_get_attr_str(INTERP, obj, id_attr);
+ VTABLE_set_pmc_keyed(INTERP, attr->probes, id, obj);
+ }
+
+/*
+=item C<PMC* instrument_class(STRING *classname)>
+
+Returns the InstrumentClass instance associated with the given classname.
+Creates a new InstrumentClass instance if there is none currently associated.
+
+=cut
+*/
+
+ METHOD instrument_class(STRING *classname) {
+ Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
+ PMC *obj_instr;
+ INTVAL class_type, obj_type;
+ PMC *class_instr, *key;
+
+ /* Create the Instrument::Event::Object instance. */
+ key = key_new_cstring(INTERP, "Instrument");
+ key_append(INTERP, key, key_new_cstring(INTERP, "Event"));
+ key_append(INTERP, key, key_new_cstring(INTERP, "Class"));
+
+ obj_type = Parrot_pmc_get_type(INTERP, key);
+ obj_instr = Parrot_pmc_new(INTERP, obj_type);
+ Parrot_pcc_invoke_method_from_c_args(INTERP, obj_instr,
+ CONST_STRING(INTERP, "new"), "->P", &obj_instr);
+
+ /* Attach to the InstrumentObject instance. */
+ class_instr = (PMC *) parrot_hash_get(INTERP, attr->instrument_classes, classname);
+ if (PMC_IS_NULL(class_instr)) {
+ class_type = Parrot_pmc_get_type_str(INTERP, CONST_STRING(INTERP, "InstrumentClass"));
+ class_instr = Parrot_pmc_new_init(INTERP, class_type, SELF);
+
+ () = PCCINVOKE(INTERP, class_instr, "attach_to_class", STRING *classname);
+
+ parrot_hash_put(INTERP, attr->instrument_classes, classname, class_instr);
+ }
+ VTABLE_set_attr_str(INTERP, obj_instr, CONST_STRING(INTERP, "$!hook_obj"), class_instr);
+
+ RETURN(PMC *obj_instr);
+ }
+
+/*
+=item C<PMC* instrument_object(PMC *object)>
+
+Returns an Instrument::Event::Object instance that is tied to the given object.
+If none exists in cache, create a new instance and return it.
+
+=cut
+*/
+
+ METHOD instrument_object(PMC *object) {
+ Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
+ PMC *obj_instr;
+ INTVAL class_type, obj_type;
+ PMC *class_instr, *key;
+ STRING *new_str, *hook_str;
+
+ new_str = CONST_STRING(INTERP, "new");
+ hook_str = CONST_STRING(INTERP, "$!hook_obj");
+
+ /* Create the Instrument::Event::Object instance. */
+ key = key_new_cstring(INTERP, "Instrument");
+ key_append(INTERP, key, key_new_cstring(INTERP, "Event"));
+ key_append(INTERP, key, key_new_cstring(INTERP, "Object"));
+
+ obj_type = Parrot_pmc_get_type(INTERP, key);
+ obj_instr = Parrot_pmc_new(INTERP, obj_type);
+ Parrot_pcc_invoke_method_from_c_args(INTERP, obj_instr, new_str, "->P", &obj_instr);
+
+ /* Attach to the InstrumentObject instance. */
+ class_instr = (PMC *) parrot_hash_get(INTERP, attr->instrument_objects, object);
+ if (PMC_IS_NULL(class_instr)) {
+ PMC *dest_key, *dest_obj;
+ INTVAL dest_type;
+
+ class_type = Parrot_pmc_get_type_str(INTERP, CONST_STRING(INTERP, "InstrumentObject"));
+ class_instr = Parrot_pmc_new_init(INTERP, class_type, SELF);
+
+ () = PCCINVOKE(INTERP, class_instr, "attach_to_object", PMC *object);
+
+ parrot_hash_put(INTERP, attr->instrument_objects, object, class_instr);
+
+ /* Create an instance of Instrument::Event::ObjectDestroy so that we can
+ be notified when the object is dead. */
+ dest_key = key_new_cstring(INTERP, "Instrument");
+ key_append(INTERP, dest_key, key_new_cstring(INTERP, "Event"));
+ key_append(INTERP, dest_key, key_new_cstring(INTERP, "ObjectDestroy"));
+
+ dest_type = Parrot_pmc_get_type(INTERP, dest_key);
+ dest_obj = Parrot_pmc_new(INTERP, dest_type);
+ Parrot_pcc_invoke_method_from_c_args(INTERP, dest_obj, new_str, "->P", &dest_obj);
+
+ VTABLE_set_attr_str(INTERP, dest_obj, hook_str, class_instr);
+ VTABLE_set_attr_str(INTERP, dest_obj, CONST_STRING(INTERP, "$!instr_obj"), SELF);
+ Parrot_pcc_invoke_method_from_c_args(INTERP, dest_obj,
+ CONST_STRING(INTERP, "_self_attach"), "->");
+ }
+ VTABLE_set_attr_str(INTERP, obj_instr, hook_str, class_instr);
+
+ RETURN(PMC *obj_instr);
+ }
+
+/*
+=item C<PMC* instrument_op()>
+
+Creates and returns an instance of Instrument::Probe that can be used
+to inspect ops being executed.
+
+=cut
+*/
+
+ METHOD instrument_op() {
+ Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
+ PMC *key, *obj;
+ INTVAL type;
+
+ key = key_new_cstring(INTERP, "Instrument");
+ key_append(INTERP, key, key_new_cstring(INTERP, "Probe"));
+
+ type = Parrot_pmc_get_type(INTERP, key);
+ obj = Parrot_pmc_new(INTERP, type);
+ (PMC *obj) = PCCINVOKE(INTERP, obj, "new");
+
+ VTABLE_set_attr_str(INTERP, obj, CONST_STRING(INTERP, "$!instr_obj"), SELF);
+ VTABLE_set_attr_str(INTERP, obj, CONST_STRING(INTERP, "$!hook_obj"), attr->instrument_rc);
+
+ RETURN(PMC *obj);
+ }
+
+/*
+=item C<PMC* instrument_gc()>
+
+Creates and returns an instance of Instrument::Event::GC that can be used
+to inspect any calls to gc functions.
+
+=cut
+*/
+
+ METHOD instrument_gc() {
+ Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
+ PMC *key, *obj;
+ INTVAL type;
+
+ key = key_new_cstring(INTERP, "Instrument");
+ key_append(INTERP, key, key_new_cstring(INTERP, "Event"));
+ key_append(INTERP, key, key_new_cstring(INTERP, "GC"));
+
+ type = Parrot_pmc_get_type(INTERP, key);
+ obj = Parrot_pmc_new(INTERP, type);
+ (PMC *obj) = PCCINVOKE(INTERP, obj, "new");
+
+ VTABLE_set_attr_str(INTERP, obj, CONST_STRING(INTERP, "$!instr_obj"), SELF);
+ VTABLE_set_attr_str(INTERP, obj, CONST_STRING(INTERP, "$!hook_obj"), attr->instrument_gc);
+
+ RETURN(PMC *obj);
+ }
+
+/*
+=item C<void register_eventhandler(STRING *event, PMC *handler)>
+
+Registers the given handler as a handler to the given event.
+Whenever the event is raised, the handler is called as well.
+
+=cut
+*/
+
+ METHOD register_eventhandler(STRING *event, PMC *handler) {
+ Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
+ probe_list_t *list;
+ PMC *ptr;
+
+ ptr = (PMC *) parrot_hash_get(INTERP, attr->event_handlers, event);
+ list = (!PMC_IS_NULL(ptr)) ? (probe_list_t *) VTABLE_get_pointer(INTERP, ptr):NULL;
+ if (list == NULL) {
+ list = probe_list_create_list(INTERP);
+ ptr = Parrot_pmc_new(INTERP, enum_class_Pointer);
+ VTABLE_set_pointer(INTERP, ptr, list);
+ parrot_hash_put(INTERP, attr->event_handlers, event, ptr);
+ }
+
+ probe_list_push(INTERP, list, handler);
+ }
+
+/*
+=item C<void remove_eventhandler(STRING *event, PMC *handler)>
+
+Deregisters the given handler from the given event, preventing the
+handler from being called when the event is raised.
+
+=cut
+*/
+
+ METHOD remove_eventhandler(STRING *event, PMC *handler) {
+ Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
+ probe_list_t *list;
+ PMC *ptr;
+
+ ptr = (PMC *) parrot_hash_get(INTERP, attr->event_handlers, event);
+ list = (!PMC_IS_NULL(ptr)) ? (probe_list_t *) VTABLE_get_pointer(INTERP, ptr):NULL;
+ if (list != NULL) {
+ probe_node_t *entry;
+ entry = probe_list_find(INTERP, list, handler);
+ probe_list_remove(INTERP, list, entry);
+ }
+ }
+
+/*
+=item C<PMC* raise_event(STRING *event, PMC *data,
+PMC *recall :optional, INTVAL has_recall :opt_flag)>
+
+Raises the given event, passing data, SELF and the handler to the
+callbacks. If given an array of callbacks (recall), will call the
+callbacks in the array instead of regenerating a list of callbacks.
+
+Returns a Pointer pmc instance if any of the callbacks returns an
+invokable, which can then be passed back to raise_event to be recalled.
+
+=cut
+*/
+
+ METHOD raise_event(STRING *event, PMC *data,
+ PMC *recall :optional, INTVAL has_recall :opt_flag) {
+ Parrot_Instrument_attributes * const attr = PARROT_INSTRUMENT(SELF);
+ probe_list_t *ret_list, *cur_list;
+ PMC *ret;
+
+ /* Build up the handlers to call. */
+ if (!has_recall || PMC_IS_NULL(recall)) {
+ Parrot_Context_info info;
+ PMC *event_tokens, *cur_event, *iter;
+
+ STRING *const_colons = CONST_STRING(INTERP, "::");
+ STRING *const_event = CONST_STRING(INTERP, "event");
+ STRING *const_file = CONST_STRING(INTERP, "file");
+ STRING *const_sub = CONST_STRING(INTERP, "sub");
+ STRING *const_line = CONST_STRING(INTERP, "line");
+ STRING *const_ns = CONST_STRING(INTERP, "namespace");
+
+ event_tokens = Parrot_str_split(INTERP, const_colons, event);
+ cur_event = Parrot_pmc_new(INTERP, enum_class_ResizableStringArray);
+ cur_list = probe_list_create_list(INTERP);
+
+ iter = VTABLE_get_iter(INTERP, event_tokens);
+ while (VTABLE_get_bool(INTERP, iter)) {
+ STRING *key;
+ probe_list_t *to_add;
+ PMC *ptr;
+
+ VTABLE_push_pmc(INTERP, cur_event, VTABLE_shift_pmc(INTERP, iter));
+ key = Parrot_str_join(INTERP, const_colons, cur_event);
+
+ ptr = (PMC *) parrot_hash_get(INTERP, attr->event_handlers, key);
+ to_add = (!PMC_IS_NULL(ptr)) ? (probe_list_t *)VTABLE_get_pointer(INTERP, ptr):NULL;
+ probe_list_append(INTERP, cur_list, to_add);
+ }
+
+ /* Add common items to data. */
+ Parrot_Context_get_info(INTERP, CURRENT_CONTEXT(attr->supervised), &info);
+ VTABLE_set_pmc_keyed_str(INTERP, data, const_event, event_tokens);
+ VTABLE_set_string_keyed_str(INTERP, data, const_file, info.file);
+ VTABLE_set_string_keyed_str(INTERP, data, const_sub, info.subname);
+ VTABLE_set_string_keyed_str(INTERP, data, const_line, info.nsname);
+ VTABLE_set_integer_keyed_str(INTERP, data, const_line, info.line);
+ }
+ else {
+ cur_list = (probe_list_t *) VTABLE_get_pointer(INTERP, recall);
+ }
+
+ /* Execute the handlers. */
+ ret_list = fire_callbacks(INTERP, cur_list, data, SELF);
+ ret = Parrot_pmc_new(INTERP, enum_class_Pointer);
+ VTABLE_set_pointer(INTERP, ret, ret_list);
+
+ RETURN(PMC *ret);
+ }
+
+/*
+=item C<void refresh_probes()>
+
+For all probes currently registered, refreshes all of them.
+All probes that are enabled when this is called will be disabled
+and then re-enabled, allowing them to re-register their events
+and hooks. This is very useful when loading dynlibs and such.
+
+=cut
+*/
+
+ METHOD refresh_probes() {
+ PMC *iter, *probes;
+ STRING *refresh;
+
+ refresh = CONST_STRING(INTERP, "refresh");
+
+ GETATTR_Instrument_probes(INTERP, SELF, probes);
+ iter = VTABLE_get_iter(INTERP, probes);
+
+ while (VTABLE_get_bool(INTERP, iter)) {
+ PMC *key, *obj, *enabled;
+ key = VTABLE_shift_pmc(INTERP, iter);
+ obj = VTABLE_get_pmc_keyed(INTERP, probes, key);
+
+ Parrot_pcc_invoke_method_from_c_args(INTERP, obj, refresh, "->");
+ }
+ }
+
+}
+
+/*
+
+=item C<probe_list_t * fire_callbacks(PARROT_INTERP,
+probe_list_t *callbacks, PMC *data, PMC *instr)>
+
+Calls the callbacks given in the list of callbacks, passing data, instr
+and the probe instance itself to the callback.
+
+Returns a list of callbacks that were returned by the invokables.
+
+For internal use only.
+
+=cut
+
+*/
+
+probe_list_t *
+fire_callbacks(PARROT_INTERP, probe_list_t *callbacks, PMC *data, PMC *instr) {
+ probe_node_t *cur;
+ probe_list_t *ret_list;
+
+ STRING *array = CONST_STRING(interp, "array");
+ STRING *callback_attr = CONST_STRING(interp, "$!callback");
+ STRING *invokable = CONST_STRING(interp, "invokable");
+
+ ret_list = probe_list_create_list(interp);
+
+ /* Execute the probes in the list. */
+ for (cur = callbacks->head; cur != NULL; cur = cur->next) {
+ PMC *callback;
+ PMC *handler;
+
+ /* Get the handler and list object. */
+ if (VTABLE_does(interp, cur->list_obj, array)) {
+ /* Obtain the probe and callback from the RPA. */
+ handler = VTABLE_get_pmc_keyed_int(interp, cur->list_obj, 0);
+ callback = VTABLE_get_pmc_keyed_int(interp, cur->list_obj, 1);
+ }
+ else {
+ /* Node contains the probe object. Obtain the callback from its attributes. */
+ handler = cur->list_obj;
+ callback = VTABLE_get_attr_str(interp, handler, callback_attr);
+ }
+
+ if (!PMC_IS_NULL(callback)) {
+ /* Pass params: InstrumentOp, Instrument, Instrument::Probe.
+ If a PMC is returned, only push it into the recall list if
+ it is invokable. */
+ PMC *recall = PMCNULL;
+ Parrot_ext_call(interp, callback, "PPP->P", data, instr, handler, &recall);
+
+ if (!PMC_IS_NULL(recall) && VTABLE_does(interp, recall, invokable)) {
+ PMC *list_entry;
+
+ list_entry = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
+ VTABLE_push_pmc(interp, list_entry, handler);
+ VTABLE_push_pmc(interp, list_entry, recall);
+
+ probe_list_push(interp, ret_list, list_entry);
+ }
+ }
+ }
+
+ /* Cleanup list and return. */
+ probe_list_delete_list(interp, callbacks);
+ return ret_list;
+}
+
+/*
+
+=item C<PMC *instrument_pack_params(PARROT_INTERP, const char *format, ...)>
+
+Packs the given variable list of arguments according to the given
+format into a ResizablePMCArray.
+
+For internal use only.
+
+=cut
+
+*/
+
+PMC *instrument_pack_params(PARROT_INTERP, const char *format, ...) {
+ PMC *ret;
+ va_list args;
+ char const * cur;
+
+ va_start(args, format);
+ ret = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
+
+ for (cur = format; *cur != '\0'; cur++) {
+ /* P : PMC
+ I : integer
+ F : floatval
+ S : string
+ V : pointer */
+ switch (*cur) {
+ case 'P':
+ VTABLE_push_pmc(interp, ret, (PMC *) va_arg(args, PMC *));
+ break;
+ case 'I':
+ VTABLE_push_integer(interp, ret, (INTVAL) va_arg(args, INTVAL));
+ break;
+ case 'F':
+ VTABLE_push_float(interp, ret, (FLOATVAL) va_arg(args, FLOATVAL));
+ break;
+ case 'S':
+ VTABLE_push_string(interp, ret, (STRING *) va_arg(args, STRING *));
+ break;
+ case 'V':
+ {
+ PMC *ptr;
+ ptr = Parrot_pmc_new(interp, enum_class_Pointer);
+ VTABLE_set_pointer(interp, ptr, (void *) va_arg(args, void *));
+ VTABLE_push_pmc(interp, ret, ptr);
+ }
+ break;
+ default:
+ /* Unknown. */
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "Unknown format in instrument_pack_params: %c\n", cur);
+ }
+ }
+
+ return ret;
+}
+
+/*
+ * Functions implementing the linked list for the probes.
+ */
+
+/*
+ * Creates a new list.
+ */
+probe_list_t *probe_list_create_list(PARROT_INTERP) {
+ probe_list_t *list;
+
+ list = mem_gc_allocate_zeroed_typed(interp, probe_list_t);
+
+ list->head = NULL;
+ list->tail = NULL;
+ list->count = 0;
+
+ return list;
+}
+
+/*
+ * Creates a new list node.
+ */
+probe_node_t *probe_list_create_node(PARROT_INTERP) {
+ probe_node_t *node;
+
+ node = mem_gc_allocate_zeroed_typed(interp, probe_node_t);
+
+ node->next = NULL;
+ node->prev = NULL;
+ node->list_obj = NULL;
+
+ return node;
+}
+
+/*
+ * Deletes the list.
+ */
+void probe_list_delete_list(PARROT_INTERP, probe_list_t *list) {
+ probe_node_t *node, *next;
+ if (list == NULL) { return; }
+
+ node = list->head;
+ while (node != NULL) {
+ next = node->next;
+ probe_list_delete_node(interp, node);
+ node = next;
+ }
+
+ mem_gc_free(interp, list);
+}
+
+/*
+ * Deletes the node.
+ */
+void probe_list_delete_node(PARROT_INTERP, probe_node_t *node) {
+ if (node == NULL) { return; }
+ mem_gc_free(interp, node);
+}
+
+/*
+ * Pushes item to the end of the list.
+ */
+void probe_list_push(PARROT_INTERP, probe_list_t *list, PMC *item) {
+ probe_node_t *node = probe_list_create_node(interp);
+ node->list_obj = item;
+
+ if (list->head == NULL) {
+ list->head = list->tail = node;
+ }
+ else {
+ node->prev = list->tail;
+ node->next = NULL;
+ list->tail->next = node;
+ list->tail = node;
+ }
+
+ list->count++;
+}
+
+/*
+ * Removes item at the end of the list.
+ */
+PMC * probe_list_pop(PARROT_INTERP, probe_list_t *list) {
+ PMC *item = PMCNULL;
+ probe_node_t *node = list->tail;
+
+ if (node != NULL) {
+ if (node == list->head) {
+ list->head = list->tail = NULL;
+ }
+ else {
+ list->tail = node->prev;
+ list->tail->next = NULL;
+ }
+
+ item = node->list_obj;
+
+ probe_list_delete_node(interp, node);
+ }
+
+ list->count--;
+ return item;
+}
+
+/*
+ * Removes the given node. Used with probe_list_find.
+ * Returns the item in that node.
+ */
+PMC * probe_list_remove(PARROT_INTERP, probe_list_t *list, probe_node_t *node) {
+ PMC *item;
+ if (node == NULL) { return PMCNULL; }
+
+ if (node == list->head) { list->head = node->next; }
+ if (node == list->tail) { list->tail = node->prev; }
+
+ if (node->prev != NULL) { node->prev->next = node->next; }
+ if (node->next != NULL) { node->next->prev = node->prev; }
+
+ item = node->list_obj;
+
+ probe_list_delete_node(interp, node);
+
+ list->count--;
+ return item;
+}
+
+/*
+ * Locates item within the list and returns the node.
+ */
+probe_node_t *probe_list_find(PARROT_INTERP, probe_list_t *list, PMC *val) {
+ probe_node_t *cur_node = list->head;
+
+ while (cur_node != NULL) {
+ if (cur_node->list_obj == val) { return cur_node; }
+
+ cur_node = cur_node->next;
+ }
+
+ return NULL;
+}
+
+/*
+ * Appends list src to the end of list dest.
+ * Nodes are duplicated.
+ */
+void probe_list_append(PARROT_INTERP, probe_list_t *dest, probe_list_t *src) {
+ probe_node_t *cur, *dup;
+ if (src == NULL || dest == NULL) { return; }
+
+ for (cur = src->head; cur != NULL; cur = cur->next) {
+ probe_list_push(interp, dest, cur->list_obj);
+ dest->count++;
+ }
+}
+
+/*
+=back
+
+=head1 SEE ALS0
+
+=cut
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
View
38 src/dynpmc/instrument_extern.h
@@ -0,0 +1,38 @@
+/* instrument_extern.h
+ * Copyright (C) 2010, Parrot Foundation.
+ * SVN Info
+ * $Id: instrument_extern.h 48438 2010-08-12 19:43:40Z khairul $
+ * Overview:
+ * This header defines as extern functions that are
+ * implemented in Instrument.pmc but used by others.
+ * Data Structure and Algorithms:
+ * History:
+ * Notes:
+ * References:
+ */
+
+#ifndef PARROT_INSTRUMENT_EXTERN_H_GUARD
+#define PARROT_INSTRUMENT_EXTERN_H_GUARD
+
+extern probe_list_t *fire_callbacks(PARROT_INTERP, probe_list_t *callbacks, PMC *data, PMC *instr);
+extern PMC *instrument_pack_params(PARROT_INTERP, const char *format, ...);
+
+/* Linked List operations */
+extern probe_list_t *probe_list_create_list(PARROT_INTERP);
+extern probe_node_t *probe_list_create_node(PARROT_INTERP);
+extern void probe_list_delete_list(PARROT_INTERP, probe_list_t *list);
+extern void probe_list_delete_node(PARROT_INTERP, probe_node_t *node);
+extern void probe_list_push(PARROT_INTERP, probe_list_t *list, PMC *item);
+extern PMC *probe_list_pop(PARROT_INTERP, probe_list_t *list);
+extern PMC *probe_list_remove(PARROT_INTERP, probe_list_t *list, probe_node_t *node);
+extern probe_node_t *probe_list_find(PARROT_INTERP, probe_list_t *list, PMC *val);
+extern void probe_list_append(PARROT_INTERP, probe_list_t *dest, probe_list_t *src);
+
+#endif /* PARROT_INSTRUMENT_EXTERN_H_GUARD */
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
View
38 src/dynpmc/instrument_private.h
@@ -0,0 +1,38 @@
+/* instrument_private.h
+ * Copyright (C) 2010, Parrot Foundation.
+ * SVN Info
+ * $Id: instrument_private.h 48438 2010-08-12 19:43:40Z khairul $
+ * Overview:
+ * This header defines common data structures used by Instrument.
+ * Data Structure and Algorithms:
+ * History:
+ * Notes:
+ * References:
+ */
+
+#ifndef PARROT_INSTRUMENT_PRIVATE_H_GUARD
+#define PARROT_INSTRUMENT_PRIVATE_H_GUARD
+
+/*
+ * Structures for the linked list data type.
+ * TODO: Await merge to trunk of bacek's list. Then we use that instead.
+ */
+
+typedef struct probe_node_t {
+ struct probe_node_t *next, *prev;
+ PMC *list_obj;
+} probe_node_t;
+
+typedef struct probe_list_t {
+ probe_node_t *head, *tail;
+ INTVAL count;
+} probe_list_t;
+
+#endif /* PARROT_INSTRUMENT_PRIVATE_H_GUARD */
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
View
5,369 src/dynpmc/instrumentclass.pmc
5,369 additions, 0 deletions not shown
View
1,109 src/dynpmc/instrumentgc.pmc
@@ -0,0 +1,1109 @@
+/*
+Copyright (C) 2010, Parrot Foundation.
+$Id: instrumentgc.pmc 48438 2010-08-12 19:43:40Z khairul $
+
+=head1 NAME
+
+src/dynpmc/instrumentgc.pmc - Interface to instrument the gc_sys entry of Parrot_Interp.
+
+=head1 DESCRIPTION
+
+C<InstrumentPMC> is a PMC class that provides an interface to
+instrument the gc_sys entry of Parrot_Interp.
+
+=head2 Methods
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+
+#include "pmc_instrument.h"
+#include "../gc/gc_private.h"
+
+#include "instrument_private.h"
+#include "instrument_extern.h"
+
+/* BELOW LIES GENERATED CODE GENERATED BY tools/build/gen_gc_stubs.pl */
+typedef struct InstrumentGC_Subsystem {
+ /* Common entries taken from GC_Subsystem. */
+ /* BEGIN gc struct entries */
+gc_sys_type_enum sys_type;
+void (*finalize_gc_system) (PARROT_INTERP);
+void (*destroy_child_interp)(Interp *dest_interp, Interp *child_interp);
+void (*do_gc_mark)(PARROT_INTERP, UINTVAL flags);
+void (*compact_string_pool)(PARROT_INTERP);
+void (*mark_special)(PARROT_INTERP, PMC *);
+void (*pmc_needs_early_collection)(PARROT_INTERP, PMC *);
+void (*init_pool)(PARROT_INTERP, struct Fixed_Size_Pool *);
+PMC* (*allocate_pmc_header)(PARROT_INTERP, UINTVAL flags);
+void (*free_pmc_header)(PARROT_INTERP, PMC *);
+STRING* (*allocate_string_header)(PARROT_INTERP, UINTVAL flags);
+void (*free_string_header)(PARROT_INTERP, STRING*);
+Buffer* (*allocate_bufferlike_header)(PARROT_INTERP, size_t size);
+void (*free_bufferlike_header)(PARROT_INTERP, Buffer*, size_t size);
+void* (*allocate_pmc_attributes)(PARROT_INTERP, PMC *);
+void (*free_pmc_attributes)(PARROT_INTERP, PMC *);
+void (*allocate_string_storage)(PARROT_INTERP, STRING *str, size_t size);
+void (*reallocate_string_storage)(PARROT_INTERP, STRING *str, size_t size);
+void (*allocate_buffer_storage)(PARROT_INTERP, ARGMOD(Buffer *buffer), size_t nsize);
+void (*reallocate_buffer_storage)(PARROT_INTERP, ARGMOD(Buffer *buffer), size_t newsize);
+void* (*allocate_fixed_size_storage)(PARROT_INTERP, size_t size);
+void (*free_fixed_size_storage)(PARROT_INTERP, size_t size, void *);
+void* (*allocate_memory_chunk)(PARROT_INTERP, size_t size);
+void* (*reallocate_memory_chunk)(PARROT_INTERP, void *data, size_t newsize);
+void* (*allocate_memory_chunk_with_interior_pointers)(PARROT_INTERP, size_t size);
+void* (*reallocate_memory_chunk_with_interior_pointers)(PARROT_INTERP, void *data,
+ size_t oldsize, size_t newsize);
+void (*free_memory_chunk)(PARROT_INTERP, void *data);
+void (*block_mark)(PARROT_INTERP);
+void (*unblock_mark)(PARROT_INTERP);
+unsigned int (*is_blocked_mark)(PARROT_INTERP);
+void (*block_sweep)(PARROT_INTERP);
+void (*unblock_sweep)(PARROT_INTERP);
+unsigned int (*is_blocked_sweep)(PARROT_INTERP);
+size_t (*get_gc_info)(PARROT_INTERP, Interpinfo_enum);
+ /* END gc struct entries */
+ /* End of common entries. */
+
+ /* Additional Entries. */
+ PMC *instrument_gc;
+ Parrot_Interp supervisor;
+ GC_Subsystem *original;
+} InstrumentGC_Subsystem;
+/* END OF GENERATED CODE */
+
+/* Macros for generated stubs */
+#define GC_STUB_VARS \
+ GC_Subsystem *gc_orig = ((InstrumentGC_Subsystem *) interp->gc_sys)->original; \
+ Parrot_Interp supervisor = ((InstrumentGC_Subsystem *) interp->gc_sys)->supervisor; \
+ PMC *instrumentgc = ((InstrumentGC_Subsystem *) interp->gc_sys)->instrument_gc; \
+ PMC *instrument, *recall, *event_data, *temp, *params, *event_array; \
+ STRING *raise_event, *event; \
+ event_data = Parrot_pmc_new(supervisor, enum_class_Hash);
+
+#define GC_STUB_CALL_PRE \
+ VTABLE_set_pmc_keyed_str(supervisor, event_data, \
+ CONST_STRING(supervisor, "parameters"), params); \
+ raise_event = CONST_STRING(supervisor, "raise_event"); \
+ GETATTR_InstrumentGC_instrument(supervisor, instrumentgc, instrument); \
+ Parrot_pcc_invoke_method_from_c_args(supervisor, instrument, raise_event, \
+ "SP->P", event, event_data, &recall);
+
+#define GC_STUB_CALL_POST \
+ Parrot_pcc_invoke_method_from_c_args(supervisor, instrument, raise_event, \
+ "SPP->P", event, event_data, recall, &recall); \
+ probe_list_delete_list(supervisor, (probe_list_t *)VTABLE_get_pointer(supervisor, recall));
+
+/* Prototypes for helper functions. */
+void setup_gc_common_hashes(PARROT_INTERP);
+void destroy_gc_common_hashes(PARROT_INTERP);
+void setup_gc_individual_hashes(PARROT_INTERP, Hash *orig_hash, Hash *instr_hash,
+ GC_Subsystem *gc_orig, InstrumentGC_Subsystem *gc_instr);
+
+/* Globals used internally. */
+static INTVAL gc_first_run = 1;
+static Hash *gc_registry = NULL;
+static Hash *gc_name_stubs = NULL;
+static Hash *gc_group_items = NULL;
+static Hash *gc_item_groups = NULL;
+
+pmclass InstrumentGC auto_attrs dynpmc group instrument_group extends InstrumentStubBase {
+
+/*
+=item C<void init_pmc(PMC *instrument)>
+
+Initialises and prepares the supervised interpreter for GC instrumenting.
+
+=cut
+
+*/
+
+ VTABLE void init_pmc(PMC *instrument) {
+ Parrot_InstrumentGC_attributes * const attr = PARROT_INSTRUMENTGC(SELF);
+ Parrot_Interp supervised;
+ InstrumentGC_Subsystem *sub;
+ SUPER(instrument);
+
+ GETATTR_Instrument_supervised(INTERP, instrument, supervised);
+
+ /* Initialise the structs */
+ sub = mem_gc_allocate_zeroed_typed(INTERP, InstrumentGC_Subsystem);
+ attr->original_struct = supervised->gc_sys;
+ attr->instrumented_struct = sub;
+
+ /* Initiliase the instrumented gc_sys with the original values. */
+ sub->instrument_gc = SELF;
+ sub->supervisor = INTERP;
+ sub->original = (GC_Subsystem *) attr->original_struct;
+
+ /* Set the gc_sys of the supervised to the instrumented gc_sys. */
+ mem_copy_n_typed(attr->instrumented_struct, attr->original_struct, 1, GC_Subsystem);
+ supervised->gc_sys = (GC_Subsystem *) attr->instrumented_struct;
+
+ /* Initialise the hashes. */
+ setup_gc_common_hashes(INTERP);
+ setup_gc_individual_hashes(INTERP, attr->name_original, attr->name_offset,
+ (GC_Subsystem *) attr->original_struct,
+ (InstrumentGC_Subsystem *) attr->instrumented_struct);
+
+ /* Update the attributes to point to the static hashes. */
+ attr->name_stubs = gc_name_stubs;
+ attr->group_items = gc_group_items;
+ attr->item_groups = gc_item_groups;
+
+ /* Register self in the registry. */
+ parrot_hash_put(INTERP, gc_registry, SELF, SELF);
+ }
+
+/*
+
+=item C<void destroy()>
+
+Performs cleanup for InstrumentGC attributes.
+
+=cut
+
+*/
+
+ VTABLE void destroy() {
+ Parrot_InstrumentGC_attributes * const attr = PARROT_INSTRUMENTGC(SELF);
+ SUPER();
+ parrot_hash_delete(INTERP, gc_registry, SELF);
+ destroy_gc_common_hashes(INTERP);
+ }
+}
+
+/* BELOW LIES GENERATED CODE GENERATED BY tools/build/gen_gc_stubs.pl */
+/* BEGIN gc prototypes */
+void stub_finalize_gc_system(PARROT_INTERP);
+void stub_destroy_child_interp(Interp* dest_interp, Interp* child_interp);
+void stub_do_gc_mark(PARROT_INTERP, UINTVAL flags);
+void stub_compact_string_pool(PARROT_INTERP);
+void stub_mark_special(PARROT_INTERP, PMC* stub_var1);
+void stub_pmc_needs_early_collection(PARROT_INTERP, PMC* stub_var1);
+void stub_init_pool(PARROT_INTERP, struct Fixed_Size_Pool* stub_var1);
+PMC* stub_allocate_pmc_header(PARROT_INTERP, UINTVAL flags);
+void stub_free_pmc_header(PARROT_INTERP, PMC* stub_var1);
+STRING* stub_allocate_string_header(PARROT_INTERP, UINTVAL flags);
+void stub_free_string_header(PARROT_INTERP, STRING* stub_var1);
+Buffer* stub_allocate_bufferlike_header(PARROT_INTERP, size_t size);
+void stub_free_bufferlike_header(PARROT_INTERP, Buffer* stub_var1, size_t size);
+void* stub_allocate_pmc_attributes(PARROT_INTERP, PMC* stub_var1);
+void stub_free_pmc_attributes(PARROT_INTERP, PMC* stub_var1);
+void stub_allocate_string_storage(PARROT_INTERP, STRING* str, size_t size);
+void stub_reallocate_string_storage(PARROT_INTERP, STRING* str, size_t size);
+void stub_allocate_buffer_storage(PARROT_INTERP, Buffer* buffer, size_t nsize);
+void stub_reallocate_buffer_storage(PARROT_INTERP, Buffer* buffer, size_t newsize);
+void* stub_allocate_fixed_size_storage(PARROT_INTERP, size_t size);
+void stub_free_fixed_size_storage(PARROT_INTERP, size_t size, void* stub_var1);
+void* stub_allocate_memory_chunk(PARROT_INTERP, size_t size);
+void* stub_reallocate_memory_chunk(PARROT_INTERP, void* data, size_t newsize);
+void* stub_allocate_memory_chunk_with_interior_pointers(PARROT_INTERP, size_t size);
+void* stub_reallocate_memory_chunk_with_interior_pointers(PARROT_INTERP, void* data,
+ size_t oldsize, size_t newsize);
+void stub_free_memory_chunk(PARROT_INTERP, void* data);
+void stub_block_mark(PARROT_INTERP);
+void stub_unblock_mark(PARROT_INTERP);
+void stub_block_sweep(PARROT_INTERP);
+void stub_unblock_sweep(PARROT_INTERP);
+/* END gc prototypes */
+
+void setup_gc_common_hashes(PARROT_INTERP) {
+ PMC *temp;
+ if (!gc_first_run) return;
+
+ gc_first_run = 0;
+ gc_registry = parrot_new_pointer_hash(interp);
+ gc_name_stubs = parrot_new_hash(interp);
+ gc_group_items = parrot_new_hash(interp);
+ gc_item_groups = parrot_new_hash(interp);
+
+ /* BEGIN gc mapping name stubs */
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "finalize_gc_system"),
+ stub_finalize_gc_system);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "destroy_child_interp"),
+ stub_destroy_child_interp);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "do_gc_mark"),
+ stub_do_gc_mark);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "compact_string_pool"),
+ stub_compact_string_pool);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "mark_special"),
+ stub_mark_special);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "pmc_needs_early_collection"),
+ stub_pmc_needs_early_collection);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "init_pool"),
+ stub_init_pool);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "allocate_pmc_header"),
+ stub_allocate_pmc_header);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "free_pmc_header"),
+ stub_free_pmc_header);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "allocate_string_header"),
+ stub_allocate_string_header);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "free_string_header"),
+ stub_free_string_header);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "allocate_bufferlike_header"),
+ stub_allocate_bufferlike_header);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "free_bufferlike_header"),
+ stub_free_bufferlike_header);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "allocate_pmc_attributes"),
+ stub_allocate_pmc_attributes);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "free_pmc_attributes"),
+ stub_free_pmc_attributes);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "allocate_string_storage"),
+ stub_allocate_string_storage);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "reallocate_string_storage"),
+ stub_reallocate_string_storage);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "allocate_buffer_storage"),
+ stub_allocate_buffer_storage);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "reallocate_buffer_storage"),
+ stub_reallocate_buffer_storage);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "allocate_fixed_size_storage"),
+ stub_allocate_fixed_size_storage);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "free_fixed_size_storage"),
+ stub_free_fixed_size_storage);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "allocate_memory_chunk"),
+ stub_allocate_memory_chunk);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "reallocate_memory_chunk"),
+ stub_reallocate_memory_chunk);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "allocate_memory_chunk_with_interior_pointers"),
+ stub_allocate_memory_chunk_with_interior_pointers);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "reallocate_memory_chunk_with_interior_pointers"),
+ stub_reallocate_memory_chunk_with_interior_pointers);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "free_memory_chunk"),
+ stub_free_memory_chunk);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "block_mark"),
+ stub_block_mark);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "unblock_mark"),
+ stub_unblock_mark);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "block_sweep"),
+ stub_block_sweep);
+ parrot_hash_put(interp, gc_name_stubs,
+ CONST_STRING(interp, "unblock_sweep"),
+ stub_unblock_sweep);
+ /* END gc mapping name stubs */
+
+ /* BEGIN gc mapping group items */
+ temp = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "free_pmc_header"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "free_string_header"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "free_bufferlike_header"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "free_pmc_attributes"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "free_fixed_size_storage"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "free_memory_chunk"));
+ parrot_hash_put(interp, gc_group_items,
+ CONST_STRING(interp, "free"),
+ temp);
+
+ temp = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "finalize_gc_system"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "destroy_child_interp"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "do_gc_mark"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "compact_string_pool"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "mark_special"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "pmc_needs_early_collection"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "init_pool"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "block_mark"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "unblock_mark"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "block_sweep"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "unblock_sweep"));
+ parrot_hash_put(interp, gc_group_items,
+ CONST_STRING(interp, "administration"),
+ temp);
+
+ temp = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_pmc_header"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_string_header"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_bufferlike_header"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_pmc_attributes"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_string_storage"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_buffer_storage"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_fixed_size_storage"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_memory_chunk"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_memory_chunk_with_interior_pointers"));
+ parrot_hash_put(interp, gc_group_items,
+ CONST_STRING(interp, "allocate"),
+ temp);
+
+ temp = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "finalize_gc_system"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "destroy_child_interp"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "do_gc_mark"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "compact_string_pool"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "mark_special"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "pmc_needs_early_collection"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "init_pool"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_pmc_header"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "free_pmc_header"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_string_header"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "free_string_header"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_bufferlike_header"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "free_bufferlike_header"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_pmc_attributes"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "free_pmc_attributes"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_string_storage"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "reallocate_string_storage"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_buffer_storage"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "reallocate_buffer_storage"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_fixed_size_storage"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "free_fixed_size_storage"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_memory_chunk"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "reallocate_memory_chunk"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "allocate_memory_chunk_with_interior_pointers"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "reallocate_memory_chunk_with_interior_pointers"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "free_memory_chunk"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "block_mark"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "unblock_mark"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "block_sweep"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "unblock_sweep"));
+ parrot_hash_put(interp, gc_group_items,
+ CONST_STRING(interp, "all"),
+ temp);
+
+ temp = Parrot_pmc_new(interp, enum_class_ResizableStringArray);
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "reallocate_string_storage"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "reallocate_buffer_storage"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "reallocate_memory_chunk"));
+ VTABLE_push_string(interp, temp,
+ CONST_STRING(interp, "reallocate_memory_chunk_with_interior_pointers"));
+ parrot_hash_put(interp, gc_group_items,
+ CONST_STRING(interp, "reallocate"),
+ temp);
+ /* END gc mapping group items */
+
+ /* BEGIN gc mapping item groups */
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "finalize_gc_system"),
+ CONST_STRING(interp, "administration"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "destroy_child_interp"),
+ CONST_STRING(interp, "administration"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "do_gc_mark"),
+ CONST_STRING(interp, "administration"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "compact_string_pool"),
+ CONST_STRING(interp, "administration"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "mark_special"),
+ CONST_STRING(interp, "administration"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "pmc_needs_early_collection"),
+ CONST_STRING(interp, "administration"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "init_pool"),
+ CONST_STRING(interp, "administration"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "allocate_pmc_header"),
+ CONST_STRING(interp, "allocate"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "free_pmc_header"),
+ CONST_STRING(interp, "free"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "allocate_string_header"),
+ CONST_STRING(interp, "allocate"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "free_string_header"),
+ CONST_STRING(interp, "free"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "allocate_bufferlike_header"),
+ CONST_STRING(interp, "allocate"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "free_bufferlike_header"),
+ CONST_STRING(interp, "free"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "allocate_pmc_attributes"),
+ CONST_STRING(interp, "allocate"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "free_pmc_attributes"),
+ CONST_STRING(interp, "free"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "allocate_string_storage"),
+ CONST_STRING(interp, "allocate"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "reallocate_string_storage"),
+ CONST_STRING(interp, "reallocate"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "allocate_buffer_storage"),
+ CONST_STRING(interp, "allocate"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "reallocate_buffer_storage"),
+ CONST_STRING(interp, "reallocate"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "allocate_fixed_size_storage"),
+ CONST_STRING(interp, "allocate"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "free_fixed_size_storage"),
+ CONST_STRING(interp, "free"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "allocate_memory_chunk"),
+ CONST_STRING(interp, "allocate"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "reallocate_memory_chunk"),
+ CONST_STRING(interp, "reallocate"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "allocate_memory_chunk_with_interior_pointers"),
+ CONST_STRING(interp, "allocate"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "reallocate_memory_chunk_with_interior_pointers"),
+ CONST_STRING(interp, "reallocate"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "free_memory_chunk"),
+ CONST_STRING(interp, "free"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "block_mark"),
+ CONST_STRING(interp, "administration"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "unblock_mark"),
+ CONST_STRING(interp, "administration"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "block_sweep"),
+ CONST_STRING(interp, "administration"));
+ parrot_hash_put(interp, gc_item_groups,
+ CONST_STRING(interp, "unblock_sweep"),
+ CONST_STRING(interp, "administration"));
+ /* END gc mapping item groups */
+}
+
+void destroy_gc_common_hashes(PARROT_INTERP) {
+ if (gc_registry == NULL) { return; }
+
+ if (parrot_hash_size(interp, gc_registry) == 0) {
+ parrot_hash_destroy(interp, gc_registry);
+ parrot_hash_destroy(interp, gc_name_stubs);
+ parrot_hash_destroy(interp, gc_group_items);
+ parrot_hash_destroy(interp, gc_item_groups);
+
+ gc_first_run = 1;
+ gc_registry = NULL;
+ gc_name_stubs = NULL;
+ gc_group_items = NULL;
+ gc_item_groups = NULL;
+ }
+}
+
+void setup_gc_individual_hashes(PARROT_INTERP, Hash *orig_hash, Hash *instr_hash,
+ GC_Subsystem *gc_orig, InstrumentGC_Subsystem *gc_instr) {
+ /* BEGIN gc mapping name offset */
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "finalize_gc_system"),
+ &(gc_instr->finalize_gc_system));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "destroy_child_interp"),
+ &(gc_instr->destroy_child_interp));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "do_gc_mark"),
+ &(gc_instr->do_gc_mark));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "compact_string_pool"),
+ &(gc_instr->compact_string_pool));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "mark_special"),
+ &(gc_instr->mark_special));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "pmc_needs_early_collection"),
+ &(gc_instr->pmc_needs_early_collection));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "init_pool"),
+ &(gc_instr->init_pool));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "allocate_pmc_header"),
+ &(gc_instr->allocate_pmc_header));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "free_pmc_header"),
+ &(gc_instr->free_pmc_header));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "allocate_string_header"),
+ &(gc_instr->allocate_string_header));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "free_string_header"),
+ &(gc_instr->free_string_header));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "allocate_bufferlike_header"),
+ &(gc_instr->allocate_bufferlike_header));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "free_bufferlike_header"),
+ &(gc_instr->free_bufferlike_header));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "allocate_pmc_attributes"),
+ &(gc_instr->allocate_pmc_attributes));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "free_pmc_attributes"),
+ &(gc_instr->free_pmc_attributes));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "allocate_string_storage"),
+ &(gc_instr->allocate_string_storage));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "reallocate_string_storage"),
+ &(gc_instr->reallocate_string_storage));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "allocate_buffer_storage"),
+ &(gc_instr->allocate_buffer_storage));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "reallocate_buffer_storage"),
+ &(gc_instr->reallocate_buffer_storage));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "allocate_fixed_size_storage"),
+ &(gc_instr->allocate_fixed_size_storage));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "free_fixed_size_storage"),
+ &(gc_instr->free_fixed_size_storage));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "allocate_memory_chunk"),
+ &(gc_instr->allocate_memory_chunk));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "reallocate_memory_chunk"),
+ &(gc_instr->reallocate_memory_chunk));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "allocate_memory_chunk_with_interior_pointers"),
+ &(gc_instr->allocate_memory_chunk_with_interior_pointers));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "reallocate_memory_chunk_with_interior_pointers"),
+ &(gc_instr->reallocate_memory_chunk_with_interior_pointers));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "free_memory_chunk"),
+ &(gc_instr->free_memory_chunk));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "block_mark"),
+ &(gc_instr->block_mark));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "unblock_mark"),
+ &(gc_instr->unblock_mark));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "block_sweep"),
+ &(gc_instr->block_sweep));
+ parrot_hash_put(interp, instr_hash,
+ CONST_STRING(interp, "unblock_sweep"),
+ &(gc_instr->unblock_sweep));
+ /* END gc mapping name offset */
+
+ /* BEGIN gc mapping name original */
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "finalize_gc_system"),
+ gc_orig->finalize_gc_system);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "destroy_child_interp"),
+ gc_orig->destroy_child_interp);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "do_gc_mark"),
+ gc_orig->do_gc_mark);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "compact_string_pool"),
+ gc_orig->compact_string_pool);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "mark_special"),
+ gc_orig->mark_special);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "pmc_needs_early_collection"),
+ gc_orig->pmc_needs_early_collection);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "init_pool"),
+ gc_orig->init_pool);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "allocate_pmc_header"),
+ gc_orig->allocate_pmc_header);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "free_pmc_header"),
+ gc_orig->free_pmc_header);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "allocate_string_header"),
+ gc_orig->allocate_string_header);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "free_string_header"),
+ gc_orig->free_string_header);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "allocate_bufferlike_header"),
+ gc_orig->allocate_bufferlike_header);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "free_bufferlike_header"),
+ gc_orig->free_bufferlike_header);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "allocate_pmc_attributes"),
+ gc_orig->allocate_pmc_attributes);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "free_pmc_attributes"),
+ gc_orig->free_pmc_attributes);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "allocate_string_storage"),
+ gc_orig->allocate_string_storage);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "reallocate_string_storage"),
+ gc_orig->reallocate_string_storage);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "allocate_buffer_storage"),
+ gc_orig->allocate_buffer_storage);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "reallocate_buffer_storage"),
+ gc_orig->reallocate_buffer_storage);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "allocate_fixed_size_storage"),
+ gc_orig->allocate_fixed_size_storage);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "free_fixed_size_storage"),
+ gc_orig->free_fixed_size_storage);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "allocate_memory_chunk"),
+ gc_orig->allocate_memory_chunk);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "reallocate_memory_chunk"),
+ gc_orig->reallocate_memory_chunk);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "allocate_memory_chunk_with_interior_pointers"),
+ gc_orig->allocate_memory_chunk_with_interior_pointers);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "reallocate_memory_chunk_with_interior_pointers"),
+ gc_orig->reallocate_memory_chunk_with_interior_pointers);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "free_memory_chunk"),
+ gc_orig->free_memory_chunk);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "block_mark"),
+ gc_orig->block_mark);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "unblock_mark"),
+ gc_orig->unblock_mark);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "block_sweep"),
+ gc_orig->block_sweep);
+ parrot_hash_put(interp, orig_hash,
+ CONST_STRING(interp, "unblock_sweep"),
+ gc_orig->unblock_sweep);
+ /* END gc mapping name original */
+}
+
+/* BEGIN gc stubs */
+void stub_finalize_gc_system(Parrot_Interp interp) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "V", interp);
+ event = CONST_STRING(supervisor, "GC::administration::finalize_gc_system");
+ GC_STUB_CALL_PRE;
+ (gc_orig->finalize_gc_system(interp));
+ GC_STUB_CALL_POST;
+}
+
+void stub_destroy_child_interp(Interp* interp, Interp* child_interp) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VV", interp, child_interp);
+ event = CONST_STRING(supervisor, "GC::administration::destroy_child_interp");
+ GC_STUB_CALL_PRE;
+ (gc_orig->destroy_child_interp(interp, child_interp));
+ GC_STUB_CALL_POST;
+}
+
+void stub_do_gc_mark(Parrot_Interp interp, UINTVAL flags) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VV", interp, flags);
+ event = CONST_STRING(supervisor, "GC::administration::do_gc_mark");
+ GC_STUB_CALL_PRE;
+ (gc_orig->do_gc_mark(interp, flags));
+ GC_STUB_CALL_POST;
+}
+
+void stub_compact_string_pool(Parrot_Interp interp) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "V", interp);
+ event = CONST_STRING(supervisor, "GC::administration::compact_string_pool");
+ GC_STUB_CALL_PRE;
+ (gc_orig->compact_string_pool(interp));
+ GC_STUB_CALL_POST;
+}
+
+void stub_mark_special(Parrot_Interp interp, PMC* stub_var1) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VP", interp, stub_var1);
+ event = CONST_STRING(supervisor, "GC::administration::mark_special");
+ GC_STUB_CALL_PRE;
+ (gc_orig->mark_special(interp, stub_var1));
+ GC_STUB_CALL_POST;
+}
+
+void stub_pmc_needs_early_collection(Parrot_Interp interp, PMC* stub_var1) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VP", interp, stub_var1);
+ event = CONST_STRING(supervisor, "GC::administration::pmc_needs_early_collection");
+ GC_STUB_CALL_PRE;
+ (gc_orig->pmc_needs_early_collection(interp, stub_var1));
+ GC_STUB_CALL_POST;
+}
+
+void stub_init_pool(Parrot_Interp interp, struct Fixed_Size_Pool* stub_var1) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VV", interp, stub_var1);
+ event = CONST_STRING(supervisor, "GC::administration::init_pool");
+ GC_STUB_CALL_PRE;
+ (gc_orig->init_pool(interp, stub_var1));
+ GC_STUB_CALL_POST;
+}
+
+PMC* stub_allocate_pmc_header(Parrot_Interp interp, UINTVAL flags) {
+ PMC* ret; PMC *ret_pack;
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VV", interp, flags);
+ event = CONST_STRING(supervisor, "GC::allocate::allocate_pmc_header");
+ VTABLE_set_integer_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "size"),
+ sizeof (PMC));
+ GC_STUB_CALL_PRE;
+ ret = (gc_orig->allocate_pmc_header(interp, flags));
+ ret_pack = instrument_pack_params(supervisor, "V", ret);
+ VTABLE_set_pmc_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "return"), ret_pack);
+ GC_STUB_CALL_POST;
+ return ret;
+}
+
+void stub_free_pmc_header(Parrot_Interp interp, PMC* stub_var1) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VP", interp, stub_var1);
+ event = CONST_STRING(supervisor, "GC::free::free_pmc_header");
+ GC_STUB_CALL_PRE;
+ (gc_orig->free_pmc_header(interp, stub_var1));
+ GC_STUB_CALL_POST;
+}
+
+STRING* stub_allocate_string_header(Parrot_Interp interp, UINTVAL flags) {
+ STRING* ret; PMC *ret_pack;
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VV", interp, flags);
+ event = CONST_STRING(supervisor, "GC::allocate::allocate_string_header");
+ VTABLE_set_integer_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "size"),
+ sizeof (STRING));
+ GC_STUB_CALL_PRE;
+ ret = (gc_orig->allocate_string_header(interp, flags));
+ ret_pack = instrument_pack_params(supervisor, "V", ret);
+ VTABLE_set_pmc_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "return"), ret_pack);
+ GC_STUB_CALL_POST;
+ return ret;
+}
+
+void stub_free_string_header(Parrot_Interp interp, STRING* stub_var1) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VS", interp, stub_var1);
+ event = CONST_STRING(supervisor, "GC::free::free_string_header");
+ GC_STUB_CALL_PRE;
+ (gc_orig->free_string_header(interp, stub_var1));
+ GC_STUB_CALL_POST;
+}
+
+Buffer* stub_allocate_bufferlike_header(Parrot_Interp interp, size_t size) {
+ Buffer* ret; PMC *ret_pack;
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VI", interp, size);
+ event = CONST_STRING(supervisor, "GC::allocate::allocate_bufferlike_header");
+ VTABLE_set_integer_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "size"),
+ sizeof (Buffer));
+ GC_STUB_CALL_PRE;
+ ret = (gc_orig->allocate_bufferlike_header(interp, size));
+ ret_pack = instrument_pack_params(supervisor, "V", ret);
+ VTABLE_set_pmc_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "return"), ret_pack);
+ GC_STUB_CALL_POST;
+ return ret;
+}
+
+void stub_free_bufferlike_header(Parrot_Interp interp, Buffer* stub_var1, size_t size) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VVI", interp, stub_var1, size);
+ event = CONST_STRING(supervisor, "GC::free::free_bufferlike_header");
+ GC_STUB_CALL_PRE;
+ (gc_orig->free_bufferlike_header(interp, stub_var1, size));
+ GC_STUB_CALL_POST;
+}
+
+void* stub_allocate_pmc_attributes(Parrot_Interp interp, PMC* stub_var1) {
+ void* ret; PMC *ret_pack;
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VP", interp, stub_var1);
+ event = CONST_STRING(supervisor, "GC::allocate::allocate_pmc_attributes");
+ VTABLE_set_integer_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "size"),
+ VTABLE_get_pmc_keyed_int(supervisor, params, 0)->vtable->attr_size);
+ GC_STUB_CALL_PRE;
+ ret = (gc_orig->allocate_pmc_attributes(interp, stub_var1));
+ ret_pack = instrument_pack_params(supervisor, "V", ret);
+ VTABLE_set_pmc_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "return"), ret_pack);
+ GC_STUB_CALL_POST;
+ return ret;
+}
+
+void stub_free_pmc_attributes(Parrot_Interp interp, PMC* stub_var1) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VP", interp, stub_var1);
+ event = CONST_STRING(supervisor, "GC::free::free_pmc_attributes");
+ GC_STUB_CALL_PRE;
+ (gc_orig->free_pmc_attributes(interp, stub_var1));
+ GC_STUB_CALL_POST;
+}
+
+void stub_allocate_string_storage(Parrot_Interp interp, STRING* str, size_t size) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VSI", interp, str, size);
+ event = CONST_STRING(supervisor, "GC::allocate::allocate_string_storage");
+ VTABLE_set_integer_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "size"),
+ size);
+ GC_STUB_CALL_PRE;
+ (gc_orig->allocate_string_storage(interp, str, size));
+ GC_STUB_CALL_POST;
+}
+
+void stub_reallocate_string_storage(Parrot_Interp interp, STRING* str, size_t size) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VSI", interp, str, size);
+ event = CONST_STRING(supervisor, "GC::reallocate::reallocate_string_storage");
+ VTABLE_set_integer_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "size"),
+ size);
+ GC_STUB_CALL_PRE;
+ (gc_orig->reallocate_string_storage(interp, str, size));
+ GC_STUB_CALL_POST;
+}
+
+void stub_allocate_buffer_storage(Parrot_Interp interp, Buffer* buffer, size_t nsize) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VVI", interp, buffer, nsize);
+ event = CONST_STRING(supervisor, "GC::allocate::allocate_buffer_storage");
+ VTABLE_set_integer_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "size"),
+ nsize);
+ GC_STUB_CALL_PRE;
+ (gc_orig->allocate_buffer_storage(interp, buffer, nsize));
+ GC_STUB_CALL_POST;
+}
+
+void stub_reallocate_buffer_storage(Parrot_Interp interp, Buffer* buffer, size_t newsize) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VVI", interp, buffer, newsize);
+ event = CONST_STRING(supervisor, "GC::reallocate::reallocate_buffer_storage");
+ VTABLE_set_integer_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "size"),
+ newsize);
+ GC_STUB_CALL_PRE;
+ (gc_orig->reallocate_buffer_storage(interp, buffer, newsize));
+ GC_STUB_CALL_POST;
+}
+
+void* stub_allocate_fixed_size_storage(Parrot_Interp interp, size_t size) {
+ void* ret; PMC *ret_pack;
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VI", interp, size);
+ event = CONST_STRING(supervisor, "GC::allocate::allocate_fixed_size_storage");
+ VTABLE_set_integer_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "size"),
+ size);
+ GC_STUB_CALL_PRE;
+ ret = (gc_orig->allocate_fixed_size_storage(interp, size));
+ ret_pack = instrument_pack_params(supervisor, "V", ret);
+ VTABLE_set_pmc_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "return"), ret_pack);
+ GC_STUB_CALL_POST;
+ return ret;
+}
+
+void stub_free_fixed_size_storage(Parrot_Interp interp, size_t size, void* stub_var1) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VIV", interp, size, stub_var1);
+ event = CONST_STRING(supervisor, "GC::free::free_fixed_size_storage");
+ GC_STUB_CALL_PRE;
+ (gc_orig->free_fixed_size_storage(interp, size, stub_var1));
+ GC_STUB_CALL_POST;
+}
+
+void* stub_allocate_memory_chunk(Parrot_Interp interp, size_t size) {
+ void* ret; PMC *ret_pack;
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VI", interp, size);
+ event = CONST_STRING(supervisor, "GC::allocate::allocate_memory_chunk");
+ VTABLE_set_integer_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "size"),
+ size);
+ GC_STUB_CALL_PRE;
+ ret = (gc_orig->allocate_memory_chunk(interp, size));
+ ret_pack = instrument_pack_params(supervisor, "V", ret);
+ VTABLE_set_pmc_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "return"), ret_pack);
+ GC_STUB_CALL_POST;
+ return ret;
+}
+
+void* stub_reallocate_memory_chunk(Parrot_Interp interp, void* data, size_t newsize) {
+ void* ret; PMC *ret_pack;
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VVI", interp, data, newsize);
+ event = CONST_STRING(supervisor, "GC::reallocate::reallocate_memory_chunk");
+ VTABLE_set_integer_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "size"),
+ newsize);
+ GC_STUB_CALL_PRE;
+ ret = (gc_orig->reallocate_memory_chunk(interp, data, newsize));
+ ret_pack = instrument_pack_params(supervisor, "V", ret);
+ VTABLE_set_pmc_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "return"), ret_pack);
+ GC_STUB_CALL_POST;
+ return ret;
+}
+
+void* stub_allocate_memory_chunk_with_interior_pointers(Parrot_Interp interp, size_t size) {
+ void* ret; PMC *ret_pack;
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VI", interp, size);
+ event = CONST_STRING(supervisor, "GC::allocate::allocate_memory_chunk_with_interior_pointers");
+ VTABLE_set_integer_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "size"),
+ size);
+ GC_STUB_CALL_PRE;
+ ret = (gc_orig->allocate_memory_chunk_with_interior_pointers(interp, size));
+ ret_pack = instrument_pack_params(supervisor, "V", ret);
+ VTABLE_set_pmc_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "return"), ret_pack);
+ GC_STUB_CALL_POST;
+ return ret;
+}
+
+void* stub_reallocate_memory_chunk_with_interior_pointers(Parrot_Interp interp, void* data,
+ size_t oldsize, size_t newsize) {
+ void* ret; PMC *ret_pack;
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VVII", interp, data, oldsize, newsize);
+ event = CONST_STRING(supervisor,
+ "GC::reallocate::reallocate_memory_chunk_with_interior_pointers");
+ VTABLE_set_integer_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "size"),
+ newsize);
+ GC_STUB_CALL_PRE;
+ ret = (gc_orig->reallocate_memory_chunk_with_interior_pointers(interp, data, oldsize, newsize));
+ ret_pack = instrument_pack_params(supervisor, "V", ret);
+ VTABLE_set_pmc_keyed_str(supervisor, event_data, CONST_STRING(supervisor, "return"), ret_pack);
+ GC_STUB_CALL_POST;
+ return ret;
+}
+
+void stub_free_memory_chunk(Parrot_Interp interp, void* data) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "VV", interp, data);
+ event = CONST_STRING(supervisor, "GC::free::free_memory_chunk");
+ GC_STUB_CALL_PRE;
+ (gc_orig->free_memory_chunk(interp, data));
+ GC_STUB_CALL_POST;
+}
+
+void stub_block_mark(Parrot_Interp interp) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "V", interp);
+ event = CONST_STRING(supervisor, "GC::administration::block_mark");
+ GC_STUB_CALL_PRE;
+ (gc_orig->block_mark(interp));
+ GC_STUB_CALL_POST;
+}
+
+void stub_unblock_mark(Parrot_Interp interp) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "V", interp);
+ event = CONST_STRING(supervisor, "GC::administration::unblock_mark");
+ GC_STUB_CALL_PRE;
+ (gc_orig->unblock_mark(interp));
+ GC_STUB_CALL_POST;
+}
+
+void stub_block_sweep(Parrot_Interp interp) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "V", interp);
+ event = CONST_STRING(supervisor, "GC::administration::block_sweep");
+ GC_STUB_CALL_PRE;
+ (gc_orig->block_sweep(interp));
+ GC_STUB_CALL_POST;
+}
+
+void stub_unblock_sweep(Parrot_Interp interp) {
+ GC_STUB_VARS;
+ params = instrument_pack_params(supervisor, "V", interp);
+ event = CONST_STRING(supervisor, "GC::administration::unblock_sweep");
+ GC_STUB_CALL_PRE;
+ (gc_orig->unblock_sweep(interp));
+ GC_STUB_CALL_POST;
+}
+
+/* END gc stubs */
+
+/* END OF GENERATED CODE */
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
View
261 src/dynpmc/instrumentinvokable.pmc
@@ -0,0 +1,261 @@
+/*
+Copyright (C) 2010, Parrot Foundation.
+$Id: instrumentinvokable.pmc 48438 2010-08-12 19:43:40Z khairul $
+
+=head1 NAME
+
+src/dynpmc/instrumentinvokable.pmc - InstrumentInvokable
+
+=head1 DESCRIPTION
+
+InstrumentInvokable is used internally to serve as an
+intermediary for invokables. This is used in InstrumentClass
+and InstrumentObject to intercept the method and vtable override
+calls.
+
+=head2 Methods
+
+=over 4
+
+=cut
+
+*/
+
+#include "pmc_instrument.h"
+
+#include "instrument_private.h"
+#include "instrument_extern.h"
+
+pmclass InstrumentInvokable auto_attrs dynpmc group instrument_group {
+ ATTR PMC *invokable;
+ ATTR PMC *instrument;
+ ATTR STRING *event;
+ ATTR Parrot_Interp interp;
+
+/*
+
+=item C<void init_pmc(PMC *instrument)>
+
+Initialises the attributes.
+
+=cut
+
+*/
+
+ VTABLE void init_pmc(PMC *instrument) {
+ Parrot_InstrumentInvokable_attributes * const attr = PARROT_INSTRUMENTINVOKABLE(SELF);
+
+ attr->invokable = PMCNULL;
+ attr->event = CONST_STRING(INTERP, "");
+ attr->instrument = instrument;
+ attr->interp = INTERP;
+ }
+
+/*
+
+=item C<opcode_t* invoke (void *next)>
+
+When invoked, raises an event with the data holding the call context
+instance. To get another event when the invokable has done executing,
+return an invokable when the first event is raised.
+
+=cut
+
+*/
+
+ VTABLE opcode_t* invoke(void *next) {
+ Parrot_InstrumentInvokable_attributes * const attr = PARROT_INSTRUMENTINVOKABLE(SELF);
+ Parrot_Interp supervised;
+ PMC *task_hash, *task, *data, *recall, *signature;
+ PMC *instrument, *invocant;
+ STRING *event;
+ opcode_t *ret;
+
+ signature = Parrot_pcc_get_signature(INTERP, CURRENT_CONTEXT(INTERP));
+ invocant = Parrot_pcc_get_object(INTERP, signature);
+ supervised = INTERP;
+ INTERP = attr->interp;
+ instrument = attr->instrument;
+ event = attr->event;
+
+ data = Parrot_pmc_new(INTERP, enum_class_Hash);
+ VTABLE_set_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP, "call_sig"), signature);
+ VTABLE_set_pmc_keyed_str(INTERP, data, CONST_STRING(INTERP, "invocant"), invocant);
+
+ (PMC *recall) = PCCINVOKE(INTERP, instrument, "raise_event", STRING *event, PMC *data);
+ ret = VTABLE_invoke(supervised, attr->invokable, next);
+ (PMC *recall) = PCCINVOKE(INTERP, instrument, "raise_event",
+ STRING *event, PMC *data, PMC *recall);
+ probe_list_delete_list(INTERP, (probe_list_t *)VTABLE_get_pointer(INTERP, recall));
+
+ return ret;
+ }
+
+/*
+
+=item C<void set_pointer(void *invokable)>
+
+Sets the invokable to invoke when the vtable invoke is called.
+
+=cut
+
+*/
+
+ VTABLE void set_pointer(void *invokable) {
+ Parrot_InstrumentInvokable_attributes * const attr = PARROT_INSTRUMENTINVOKABLE(SELF);
+ attr->invokable = (PMC *) invokable;
+ }
+
+/*
+
+=item C<void* get_pointer()>
+
+Returns the invokable PMC that was attached to this instance.
+
+=cut
+
+*/
+
+ VTABLE void* get_pointer() {
+ Parrot_InstrumentInvokable_attributes * const attr = PARROT_INSTRUMENTINVOKABLE(SELF);
+ return attr->invokable;
+ }
+
+/*
+
+=item C<STRING* name()>
+
+Returns the name of the invokable PMC that was attached to this instance.
+
+=cut
+
+*/
+
+ VTABLE STRING* name() {
+ Parrot_InstrumentInvokable_attributes * const attr = PARROT_INSTRUMENTINVOKABLE(SELF);
+ Parrot_Interp supervised;
+ GETATTR_Instrument_supervised(INTERP, attr->instrument, supervised);
+ return VTABLE_name(supervised, attr->invokable);
+ }
+
+/*
+
+=item C<STRING* get_string()>
+
+Returns the string representation of the
+invokable PMC that was attached to this instance.
+
+=cut
+
+*/
+
+ VTABLE STRING* get_string() {
+ Parrot_InstrumentInvokable_attributes * const attr = PARROT_INSTRUMENTINVOKABLE(SELF);
+ return VTABLE_get_string(INTERP, attr->invokable);
+ }
+
+/*
+
+=item C<INTVAL isa(STRING *isa)>
+=item C<INTVAL isa_pmc(PMC *isa)>
+
+Pass through the isa call to the invokable.
+
+=cut
+
+*/
+
+ VTABLE INTVAL isa(STRING *isa) {
+ Parrot_InstrumentInvokable_attributes * const attr = PARROT_INSTRUMENTINVOKABLE(SELF);
+ return VTABLE_isa(INTERP, attr->invokable, isa);
+ }
+
+ VTABLE INTVAL isa_pmc(PMC *isa) {
+ Parrot_InstrumentInvokable_attributes * const attr = PARROT_INSTRUMENTINVOKABLE(SELF);
+ return VTABLE_isa_pmc(INTERP, attr->invokable, isa);
+ }
+
+/*
+
+=item C<PMC* clone()>
+
+Pass through the clone call to the invokable.
+
+=cut
+
+*/
+
+ VTABLE PMC* clone() {
+ Parrot_InstrumentInvokable_attributes * const attr = PARROT_INSTRUMENTINVOKABLE(SELF);
+ return SUPER();
+ }
+
+/*
+
+=item C<void thaw(PMC *info)>
+
+Thaws the InstrumentInvokable instance and the invokable
+out of the given ImageIO instance.
+
+=cut
+
+*/
+
+ VTABLE void thaw(PMC *info) {
+ Parrot_InstrumentInvokable_attributes * const attr = PARROT_INSTRUMENTINVOKABLE(SELF);
+
+ attr->invokable = (PMC *) VTABLE_shift_integer(INTERP, info);
+ attr->instrument = (PMC *) VTABLE_shift_integer(INTERP, info);
+ attr->interp = (Parrot_Interp) VTABLE_shift_integer(INTERP, info);
+ attr->event = VTABLE_shift_string(INTERP, info);
+
+ VTABLE_thaw(INTERP, attr->invokable, info);
+ }
+
+/*
+
+=item C<void thaw(PMC *info)>
+
+Freezes the InstrumentInvokable instance and the invokable
+into the given ImageIO instance.
+
+=cut
+
+*/
+
+ VTABLE void freeze(PMC *info) {
+ Parrot_InstrumentInvokable_attributes * const attr = PARROT_INSTRUMENTINVOKABLE(SELF);
+
+ VTABLE_push_integer(INTERP, info, (INTVAL) attr->invokable);
+ VTABLE_push_integer(INTERP, info, (INTVAL) attr->instrument);
+ VTABLE_push_integer(INTERP, info, (INTVAL) attr->interp);
+ VTABLE_push_string(INTERP, info, attr->event);
+
+ VTABLE_freeze(INTERP, attr->invokable, info);
+ }
+
+/*
+
+=item C<void set_event(PMC *event)>
+
+Given an array of event tokens, eq ['Class','Eg','method','foo'],
+joins the array together to form the event to be raised whenever
+this instance is invoked.
+
+=cut
+
+*/
+
+ METHOD set_event(PMC *event) {
+ Parrot_InstrumentInvokable_attributes * const attr = PARROT_INSTRUMENTINVOKABLE(SELF);
+ attr->event = Parrot_str_join(INTERP, CONST_STRING(INTERP, "::"), event);
+ }
+}
+