From: Bob Rogers <[EMAIL PROTECTED]>
Date: Sun, 6 Aug 2006 11:20:08 -0400
Notes on the POC:
. . . It doesn't quite work, apparently because set_retval gives up
too soon, and so set_s_p always sets the result to a null string.
I figured this out in the process of implementing print_p. It still
gets plenty of errors, though, some of which are pretty strange. (The
one that unexpected succeeded is Matt's test case for bug #39988.)
-- Bob
------------------------------------------------------------------------
Failed 11/239 test scripts, 95.40% okay. 124/5359 subtests failed, 97.69% okay.
Failed Test Stat Wstat Total Fail Failed List of Failed
--------------------------------------------------------------------------------
t/compilers/pge/03-optable.t 31 7936 35 31 88.57% 1-23 27 29-35
t/compilers/pge/p6regex/01-regex.t 80 20480 494 80 16.19% 287-301 305-
327 330 355-
357 359-390
393-396 486-
487
t/compilers/pge/p6regex/closure.t 3 768 6 3 50.00% 1 4-5
t/compilers/pge/p6regex/context.t 1 256 20 1 5.00% 8
t/compilers/pge/pge_examples.t 1 256 2 1 50.00% 2
t/op/calling.t 1 256 93 1 1.08% 39
t/op/gc.t 1 256 22 1 4.55% 11
t/pmc/delegate.t 1 256 9 1 11.11% 9
t/pmc/mmd.t 1 256 39 1 2.56% 30
t/pmc/object-meths.t 2 512 34 2 5.88% 11 25
t/pmc/objects.t 2 512 78 2 2.56% 33 59
(1 subtest UNEXPECTEDLY SUCCEEDED), 10 tests and 459 subtests skipped.
make: *** [test] Error 255
Diffs between last version checked in and current workfile(s):
Index: include/parrot/sub.h
===================================================================
--- include/parrot/sub.h (revision 13852)
+++ include/parrot/sub.h (working copy)
@@ -118,6 +118,11 @@
struct Parrot_Context *from_ctx; /* sub, this cont is returning from */
opcode_t *current_results; /* ptr into code with get_results opcode
full continuation only */
+ cont_C_continuation_t C_continuation;
+ /* if not NULL, a C function to call
+ instead of normal return value
+ processing. */
+ PMC *C_continuation_state; /* state passed to C_continuation */
int runloop_id; /* id of the creating runloop. */
} * parrot_cont_t;
@@ -152,6 +157,16 @@
PMC* Parrot_find_pad(Interp*, STRING *lex_name, parrot_context_t *);
PMC* parrot_new_closure(Interp*, PMC*);
+opcode_t* Parrot_op_set_reg_from_vtable(Interp *, Call_bits_enum_t, INTVAL,
+ opcode_t *, get_string_method_t,
+ char *, PMC *);
+opcode_t * Parrot_op_tailcall_with_vtable_string(Interp *, opcode_t *, PMC *,
+ get_string_method_t, char *,
+ void string_fn(Interp*,
STRING*),
+ cont_C_continuation_t, PMC*);
+void parrot_op_print_string_internal(Interp*, STRING*);
+void Parrot_op_print_string_tail(Interp *, parrot_context_t *, PMC*, PMC*);
+
#endif /* PARROT_SUB_H_GUARD */
/*
Index: include/parrot/interpreter.h
===================================================================
--- include/parrot/interpreter.h (revision 13852)
+++ include/parrot/interpreter.h (working copy)
@@ -436,6 +436,12 @@
/* &end_gen */
+/* This is for a C "tailcall" function used instead of normal subroutine return
+ processing. */
+typedef void (*cont_C_continuation_t)(Interp* interpreter,
+ parrot_context_t *caller_ctx,
+ PMC* continuation, PMC* c_closure_state);
+
PARROT_API Interp *make_interpreter(Interp * parent, Interp_flags);
PARROT_API void Parrot_init(Interp *);
PARROT_API void Parrot_destroy(Interp *);
@@ -459,6 +465,8 @@
va_list);
PARROT_API void* Parrot_run_meth_fromc(Interp *, PMC *sub, PMC* obj, STRING
*meth);
+PARROT_API opcode_t * Parrot_tailcall_meth_fromc(Interp *,
+ PMC *, PMC *, opcode_t *, cont_C_continuation_t, PMC *);
PARROT_API void* Parrot_run_meth_fromc_args(Interp *, PMC *sub,
PMC* obj, STRING *meth, const char *signature, ...);
PARROT_API INTVAL Parrot_run_meth_fromc_args_reti(Interp *, PMC *sub,
Index: src/pmc/retcontinuation.pmc
===================================================================
--- src/pmc/retcontinuation.pmc (revision 13852)
+++ src/pmc/retcontinuation.pmc (working copy)
@@ -123,6 +123,11 @@
INTERP->ctx.bp = caller_ctx->bp;
INTERP->ctx.bp_ps = caller_ctx->bp_ps;
next = cc->address;
+ if (cc->C_continuation) {
+ /* The C continuation replaces results handling. */
+ cc->C_continuation(INTERP, cc->from_ctx,
+ SELF, cc->C_continuation_state);
+ }
Parrot_free_context(INTERP, cc->from_ctx, 1);
seg = cc->seg;
#ifdef NDEBUG
Index: src/pmc/continuation.pmc
===================================================================
--- src/pmc/continuation.pmc (revision 13852)
+++ src/pmc/continuation.pmc (working copy)
@@ -87,6 +87,8 @@
struct Parrot_cont * cc = PMC_cont(SELF);
if (cc->to_ctx)
mark_context(INTERP, cc->to_ctx);
+ if (cc->C_continuation_state)
+ pobject_lives(INTERP, (PObj *)cc->C_continuation_state);
}
/*
@@ -269,6 +271,11 @@
ctx->current_results = cc->current_results;
}
pc = cc->address;
+ if (cc->C_continuation) {
+ /* The C continuation replaces results handling. */
+ cc->C_continuation(INTERP, caller_ctx,
+ SELF, cc->C_continuation_state);
+ }
if (ctx->current_results && INTERP->current_args) {
/*
* the register pointer is already switched back
Index: src/inter_run.c
===================================================================
--- src/inter_run.c (revision 13852)
+++ src/inter_run.c (working copy)
@@ -276,6 +276,31 @@
return set_retval(interpreter, 0, ctx);
}
+opcode_t *
+Parrot_tailcall_meth_fromc(Interp *interpreter,
+ PMC *sub, PMC *obj, opcode_t *return_addr,
+ cont_C_continuation_t C_cont,
+ PMC *C_cont_state)
+/* This is magic for avoiding subordinate runloops. */
+{
+ parrot_context_t *old_ctx = CONTEXT(interpreter->ctx);
+ opcode_t offset, *dest;
+ struct Parrot_cont * cc;
+
+ interpreter->current_cont
+ = new_ret_continuation_pmc(interpreter, return_addr);
+ interpreter->current_object = obj;
+ cc = PMC_cont(interpreter->current_cont);
+ cc->C_continuation = C_cont;
+ cc->C_continuation_state = C_cont_state;
+ dest = VTABLE_invoke(interpreter, sub, (void*)1);
+ if (!dest)
+ internal_exception(1, "Subroutine returned a NULL address");
+ dest = parrot_pass_args_fromc(interpreter, "O", dest,
+ old_ctx, obj);
+ return dest;
+}
+
void *
Parrot_runops_fromc_args(Parrot_Interp interpreter, PMC *sub,
const char *sig, ...)
Index: src/sub.c
===================================================================
--- src/sub.c (revision 13852)
+++ src/sub.c (working copy)
@@ -137,10 +137,13 @@
new_continuation(Interp *interp, struct Parrot_cont *to)
{
struct Parrot_cont * const cc = mem_sys_allocate(sizeof(struct
Parrot_cont));
- struct Parrot_Context * const to_ctx = to ? to->to_ctx :
CONTEXT(interp->ctx);
+ struct Parrot_Context * const to_ctx
+ = to ? to->to_ctx : CONTEXT(interp->ctx);
cc->to_ctx = to_ctx;
cc->from_ctx = CONTEXT(interp->ctx);
+ cc->C_continuation = NULL;
+ cc->C_continuation_state = NULL;
cc->runloop_id = 0;
CONTEXT(interp->ctx)->ref_count++;
if (to) {
@@ -172,6 +175,8 @@
struct Parrot_cont * const cc = mem_sys_allocate(sizeof(struct
Parrot_cont));
cc->to_ctx = CONTEXT(interp->ctx);
cc->from_ctx = NULL; /* filled in during a call */
+ cc->C_continuation = NULL;
+ cc->C_continuation_state = NULL;
cc->runloop_id = 0;
cc->seg = interp->code;
cc->current_results = NULL;
@@ -483,6 +488,177 @@
#endif
return clos_pmc;
}
+
+/* [stolen from delegate.pmc. -- rgr, 5-Aug-06.] */
+static PMC *
+find_method_internal(Interp* interpreter, PMC *pmc, STRING *meth) {
+ PMC *class = pmc;
+
+ if (PObj_is_object_TEST(pmc)) {
+ class = GET_CLASS((Buffer *)PMC_data(pmc), pmc);
+ }
+ return Parrot_find_method_with_cache(interpreter, class, meth);
+}
+
+/* [stolen from delegate.pmc. -- rgr, 5-Aug-06.] */
+static PMC *
+find_method_sub_or_die(Interp* interpreter, PMC *pmc, STRING *meth) {
+ PMC *returnPMC = find_method_internal(interpreter, pmc, meth);
+ if (PMC_IS_NULL(returnPMC)) {
+ PMC *class = pmc;
+ if (PObj_is_object_TEST(pmc)) {
+ class = GET_CLASS((Buffer *)PMC_data(pmc), pmc);
+ real_exception(interpreter, NULL, E_LookupError,
+ "Can't find method '%s' for object '%s'",
+ string_to_cstring(interpreter, meth),
+ string_to_cstring(interpreter, PMC_str_val(
+ get_attrib_num((SLOTTYPE *)PMC_data(class),
+ PCD_CLASS_NAME)))
+ );
+ } else {
+ real_exception(interpreter, NULL, E_LookupError,
+ "Can't find method '%s' - erroneous PMC",
+ string_to_cstring(interpreter, meth)
+ );
+ }
+ }
+ return returnPMC;
+}
+
+static void
+store_tail_result_into_register(Interp* interpreter,
+ parrot_context_t *returning_ctx,
+ PMC* continuation, PMC* c_closure_state)
+{
+ struct Parrot_Context *ctx = CONTEXT(interpreter->ctx);
+ INTVAL arg_type
+ = VTABLE_get_integer_keyed_int(interpreter, c_closure_state, 0);
+ INTVAL arg_register
+ = VTABLE_get_integer_keyed_int(interpreter, c_closure_state, 1);
+
+ switch (arg_type) {
+ case PARROT_ARG_STRING:
+ CTX_REG_STR(ctx, arg_register)
+ = set_retval(interpreter, 'S', returning_ctx);
+ break;
+ case PARROT_ARG_PMC:
+ CTX_REG_PMC(ctx, arg_register)
+ = set_retval(interpreter, 'P', returning_ctx);
+ break;
+ case PARROT_ARG_INTVAL:
+ case PARROT_ARG_FLOATVAL:
+ default:
+ real_exception(interpreter, NULL, 1,
+ "oops; got arg_type %d when storing tail result\n",
+ arg_type);
+ }
+}
+
+opcode_t *
+Parrot_op_set_reg_from_vtable(Interp *interpreter,
+ Call_bits_enum_t arg_type,
+ INTVAL arg_register,
+ opcode_t *next,
+ get_string_method_t vtable_method,
+ char *method_name,
+ PMC *method_object)
+{
+ struct Parrot_Context *ctx = CONTEXT(interpreter->ctx);
+
+ if (vtable_method == interpreter->vtables[enum_class_delegate]->get_string) {
+ /* winner */
+ /* fprintf(stderr, "gotcha\n"); */
+ STRING *meth = const_string(interpreter, method_name);
+ PMC *sub = find_method_sub_or_die(interpreter, method_object, meth);
+ PMC *state;
+ opcode_t *next_instruction;
+
+ state = pmc_new(interpreter, enum_class_FixedIntegerArray);
+ VTABLE_set_integer_native(interpreter, state, 2);
+ VTABLE_set_integer_keyed_int(interpreter, state, 0, (INTVAL) arg_type);
+ VTABLE_set_integer_keyed_int(interpreter, state, 1, (INTVAL)
arg_register);
+ next_instruction
+ = Parrot_tailcall_meth_fromc(interpreter, sub, method_object, next,
+ store_tail_result_into_register,
+ state);
+ return next_instruction;
+ }
+ else {
+ /* just call the method and stuff it in the register. */
+ switch (arg_type) {
+ case PARROT_ARG_INTVAL:
+ CTX_REG_INT(ctx, arg_register)
+ = (INTVAL) (*vtable_method) (interpreter, method_object);
+ break;
+ case PARROT_ARG_FLOATVAL:
+ /* CTX_REG_NUM(ctx, arg_register) = (FLOATVAL) (*vtable_method)
(interpreter, method_object); */
+ break;
+ case PARROT_ARG_STRING:
+ CTX_REG_STR(ctx, arg_register)
+ = (struct parrot_string_t *)
+ (*vtable_method) (interpreter, method_object);
+ break;
+ case PARROT_ARG_PMC:
+ CTX_REG_PMC(ctx, arg_register)
+ = (PMC *) (*vtable_method) (interpreter, method_object);
+ break;
+ default:
+ internal_exception(1, "oops\n");
+ }
+ return next;
+ }
+}
+
+void
+parrot_op_print_string_internal(Interp* interpreter,
+ STRING* const s)
+/* Helper for printing the result of a vtable method call. */
+{
+ if (s) {
+ PIO_putps(interpreter, PIO_STDOUT(interpreter), s);
+ }
+}
+
+void
+Parrot_op_print_string_tail(Interp* interpreter,
+ parrot_context_t *returning_ctx,
+ PMC* continuation, PMC* c_closure_state)
+/* Helper for printing the result of a vtable method call. */
+{
+ STRING * const s = set_retval(interpreter, 's', returning_ctx);
+ parrot_op_print_string_internal(interpreter, s);
+}
+
+opcode_t *
+Parrot_op_tailcall_with_vtable_string(Interp* interpreter,
+ opcode_t *next,
+ PMC *method_object,
+ get_string_method_t vtable_method,
+ char *method_name,
+ void string_fn(Interp*, STRING*),
+ cont_C_continuation_t continuation_fn,
+ PMC* c_closure_state)
+/* [we need to supply both tailcall_fn and continuation_fn because we don't
have
+ a mechanism for passing non-PMC data to C_continuation fns. -- rgr,
+ 8-Aug-06.] */
+{
+ struct Parrot_Context *ctx = CONTEXT(interpreter->ctx);
+
+ if (vtable_method == interpreter->vtables[enum_class_delegate]->get_string) {
+ STRING *meth = const_string(interpreter, method_name);
+ PMC *sub = find_method_sub_or_die(interpreter, method_object, meth);
+
+ return Parrot_tailcall_meth_fromc(interpreter, sub, method_object, next,
+ continuation_fn, c_closure_state);
+ }
+ else {
+ /* just call the method, and pass the resulting string the string_fn. */
+ STRING * const s = VTABLE_get_string(interpreter, method_object);
+ (*string_fn)(interpreter, s);
+ return next;
+ }
+}
+
/*
=back
Index: src/ops/core.ops
===================================================================
--- src/ops/core.ops (revision 13852)
+++ src/ops/core.ops (working copy)
@@ -544,7 +544,10 @@
ctx = CONTEXT(interpreter->ctx);
ccont = ctx->current_cont;
- if (PMC_cont(ccont)->address) {
+ if (PMC_cont(ccont)->C_continuation) {
+ /* return values will be handled at continuation invocation time. */
+ }
+ else if (PMC_cont(ccont)->address) {
/* else it's from runops_fromc */
parrot_context_t * const caller_ctx = PMC_cont(ccont)->to_ctx;
if (! caller_ctx) {
Index: src/ops/set.ops
===================================================================
--- src/ops/set.ops (revision 13852)
+++ src/ops/set.ops (working copy)
@@ -155,9 +155,15 @@
goto NEXT();
}
+/* ' */
+
inline op set(out STR, invar PMC) :base_core {
- $1 = $2->vtable->get_string(interpreter, $2);
- goto NEXT();
+ opcode_t *next = expr NEXT();
+ next = Parrot_op_set_reg_from_vtable
+ (interpreter, PARROT_ARG_STRING, cur_opcode[1], next,
+ $2->vtable->get_string, "__get_string",
+ $2);
+ goto ADDRESS(next);
}
inline op set(out STR, invar STR) :base_core {
Index: src/ops/io.ops
===================================================================
--- src/ops/io.ops (revision 13852)
+++ src/ops/io.ops (working copy)
@@ -229,13 +229,15 @@
goto NEXT();
}
+/* ' */
+
op print(invar PMC) :base_io {
PMC * const p = $1;
- STRING * const s = (VTABLE_get_string(interpreter, p));
- if (s) {
- PIO_putps(interpreter, PIO_STDOUT(interpreter), s);
- }
- goto NEXT();
+ opcode_t *next = expr NEXT();
+ next = Parrot_op_tailcall_with_vtable_string
+ (interpreter, next, $1, $1->vtable->get_string, "__get_string",
+ parrot_op_print_string_internal, Parrot_op_print_string_tail, NULL);
+ goto ADDRESS(next);
}
op write(invar PMC) :base_io {
End of diffs.
