Author: leo
Date: Sat Feb 4 08:45:43 2006
New Revision: 11419
Modified:
trunk/src/ops/ops.num
trunk/src/ops/pic.ops
trunk/src/pic.c
Log:
Interpreter hard core - callr PIC opcode 1
* create new callr opcode that is able to call C functions
very similar to interface functions
* the plan is to JIT some simple PIR subs on-the-fly
* call a test function to check if arg passing is ok
* just one result and void arguments for now
Please make realclean (and rm *.pbc) due to inserted opcode.
Modified: trunk/src/ops/ops.num
==============================================================================
--- trunk/src/ops/ops.num (original)
+++ trunk/src/ops/ops.num Sat Feb 4 08:45:43 2006
@@ -1212,3 +1212,4 @@ find_global_p_p_s 1181
find_global_p_p_sc 1182
find_name_p_s 1183
find_name_p_sc 1184
+pic_callr___pc 1185
Modified: trunk/src/ops/pic.ops
==============================================================================
--- trunk/src/ops/pic.ops (original)
+++ trunk/src/ops/pic.ops Sat Feb 4 08:45:43 2006
@@ -6,6 +6,8 @@
#include "parrot/oplib/ops.h"
+typedef opcode_t* (*interface_f)(Interp*, INTVAL*, void **);
+
VERSION = PARROT_VERSION;
=head1 NAME
@@ -230,6 +232,50 @@ inline op pic_set_returns__(inconst PMC)
goto OFFSET(0);
}
+=item B<pic_callr__>(inconst PMC)
+
+Call the function $1 as C<pc = func(interp, 0, **args)>. args[0] holds the
+address of the function result, args[1..] are function arguments, both
+according to the C<get_results> and C<set_args> opcodes. The function is
+a C interface function (or NCI) or a JITed PIR function. args[n] holds the
+C<pc> of the next opcode and is usually just returned.
+
+=cut
+
+inline op pic_callr__(inconst PMC) :pic {
+ Parrot_MIC *mic;
+ Parrot_PIC_lru *lru;
+ void *args[6]; /* TODO ARG_MAX */
+ parrot_context_t *ctx;
+ opcode_t *pc;
+ void **pred_pc;
+ PMC *sig;
+ INTVAL *bitp, n_args;
+
+ ctx = CONTEXT(interpreter->ctx);
+ mic = (Parrot_MIC *) cur_opcode[1];
+ pc = ctx->current_results;
+ if (pc) {
+ pred_pc = (void**) pc - ctx->pred_offset;
+ args[0] = (_reg_base + ((opcode_t*)pred_pc)[2]);
+ assert((sig = (PMC*)(pred_pc[1])) &&
+ PObj_is_PMC_TEST(sig) &&
+ sig->vtable->base_type == enum_class_FixedIntegerArray &&
+ VTABLE_elements(interpreter, sig) == 1);
+ }
+ else
+ args[0] = NULL;
+ /* TODO set_args */
+ n_args = 0;
+ /* set_args (); set_p_pc; get_results (1), x; invokecc_p */
+ pc = CUR_OPCODE + 2 + n_args + 3 + 3 + 2;
+ args[1 + n_args] = pc;
+ lru = &mic->lru;
+ /* TODO verify $1 didn't change */
+ pc = ((interface_f)lru->f.real_function)(interpreter, NULL, args);
+ goto ADDRESS(pc);
+}
+
=back
=cut
Modified: trunk/src/pic.c
==============================================================================
--- trunk/src/pic.c (original)
+++ trunk/src/pic.c Sat Feb 4 08:45:43 2006
@@ -83,6 +83,8 @@ lookup of the cache has to be done in th
# include "parrot/oplib/core_ops_cgp.h"
#endif
+#define PIC_TEST 0
+
/* needs a Makefile dependency */
/* #include "pmc/pmc_integer.h" */
@@ -169,6 +171,7 @@ parrot_PIC_op_is_cached(Interp *interpre
case PARROT_OP_infix_ic_p_p: return 1;
case PARROT_OP_get_params_pc: return 1;
case PARROT_OP_set_returns_pc: return 1;
+ case PARROT_OP_set_args_pc: return 1;
}
return 0;
}
@@ -475,6 +478,99 @@ is_pic_param(Interp *interpreter, void *
return 1;
}
+#if PIC_TEST
+/*
+ * just for testing the whole scheme ...
+
+.sub main :main
+ .local int i
+ i = __pic_test()
+ print i
+ print "\n"
+.end
+.sub __pic_test
+ .return (10)
+.end
+
+... prints 42, if PIC_TEST is 1, because the C function is called
+ with -C and -S runcores.
+*/
+
+static opcode_t *
+pic_test_func(Interp *interpreter, INTVAL *sig_bits, void **args)
+{
+ opcode_t *pc;
+ INTVAL *result;
+
+ result = (INTVAL*) args[0];
+ *result = 42;
+ pc = args[1];
+ return pc;
+}
+#endif
+
+static int
+is_pic_func(Interp *interpreter, void **pc, Parrot_MIC *mic, int core_type)
+{
+ PMC *sub, *sig;
+ char *base;
+ parrot_context_t *ctx;
+ opcode_t *op, n;
+#if PIC_TEST
+ STRING *name;
+#endif
+
+ /*
+ * if we have these opcodes
+ *
+ * set_args '(..)' ...
+ * set_p_pc Px, PFunx
+ * get_results '(..)' ...
+ * invokecc_p Px
+ *
+ * and all args are matching the called sub and we don't have
+ * too many args, and only INTVAL or FLOATVAL, the
+ * whole sequence is replaced by the C<callr> pic opcode.
+ *
+ * Oh, I forgot to mention - the to-be-called C function is of
+ * course compiled on-the-fly by the JIT compiler ;)
+ *
+ * pc is at set_args
+ */
+
+ base = (char*)interpreter->ctx.bp.regs_i;
+ ctx = CONTEXT(interpreter->ctx);
+ sig = (PMC*)(pc[1]);
+ assert(PObj_is_PMC_TEST(sig));
+ assert(sig->vtable->base_type == enum_class_FixedIntegerArray);
+ n = VTABLE_elements(interpreter, sig);
+ interpreter->current_args = (opcode_t*)pc + ctx->pred_offset;
+ pc += 2 + n;
+ op = (opcode_t*)pc + ctx->pred_offset;
+ if (*op != PARROT_OP_set_p_pc)
+ return 0;
+ do_prederef(pc, interpreter, core_type);
+ sub = (PMC*)(pc[2]);
+ assert(PObj_is_PMC_TEST(sub));
+ if (sub->vtable->base_type != enum_class_Sub)
+ return 0;
+ pc += 3; /* results */
+ op = (opcode_t*)pc + ctx->pred_offset;
+ if (*op != PARROT_OP_get_results_pc)
+ return 0;
+ do_prederef(pc, interpreter, core_type);
+ ctx->current_results = (opcode_t*)pc + ctx->pred_offset;
+#if PIC_TEST
+ name = VTABLE_get_string(interpreter, sub);
+ if (memcmp((char*) name->strstart, "__pic_test", 10) == 0) {
+
+ mic->lru.f.real_function = (funcptr_t) pic_test_func;
+ return 1;
+ }
+#endif
+ return 0;
+}
+
void
parrot_PIC_prederef(Interp *interpreter, opcode_t op, void **pc_pred, int core)
{
@@ -529,6 +625,12 @@ parrot_PIC_prederef(Interp *interpreter,
op = PARROT_OP_pic_set_returns___pc;
}
break;
+ case PARROT_OP_set_args_pc:
+ if (is_pic_func(interpreter, pc_pred, mic, core)) {
+ pc_pred[1] = (void*) mic;
+ op = PARROT_OP_pic_callr___pc;
+ }
+ break;
}
/*
* rewrite opcode
