Browse files

added sources

  • Loading branch information...
1 parent fd93918 commit 8e8e14e9cc9117288356d3f0188b3cc9a83baa0f @khairulsyamil committed Mar 28, 2010
Showing with 177 additions and 0 deletions.
  1. +116 −0 doctor.c
  2. +61 −0 instr.pir
View
116 doctor.c
@@ -0,0 +1,116 @@
+#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
61 instr.pir
@@ -0,0 +1,61 @@
+.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

0 comments on commit 8e8e14e

Please sign in to comment.