cvsuser 04/02/07 04:58:59
Modified: include/parrot events.h interpreter.h
src events.c interpreter.c nci_test.c
t/pmc nci.t
Log:
approaching pdd16 callbacks
s. p6i for more
Revision Changes Path
1.11 +12 -2 parrot/include/parrot/events.h
Index: events.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/events.h,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -w -r1.10 -r1.11
--- events.h 17 Jan 2004 17:54:17 -0000 1.10
+++ events.h 7 Feb 2004 12:58:46 -0000 1.11
@@ -1,7 +1,7 @@
/* events.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: events.h,v 1.10 2004/01/17 17:54:17 leo Exp $
+ * $Id: events.h,v 1.11 2004/02/07 12:58:46 leo Exp $
* Overview:
* This api will handle parrot events
* Data Structure and Algorithms:
@@ -22,6 +22,7 @@
EVENT_TYPE_MSG,
EVENT_TYPE_ASYNC_IO,
EVENT_TYPE_TIMER,
+ EVENT_TYPE_CALL_BACK,
EVENT_TYPE_SLEEP,
EVENT_TYPE_TERMINATE,
EVENT_TYPE_EVENT_TERMINATE,
@@ -40,14 +41,21 @@
} parrot_timer_event;
typedef struct {
+ PMC* sub;
+ PMC* user_data;
+ void* external_data;
+} _call_back_info;
+
+typedef struct {
parrot_event_type_enum type;
Parrot_Interp interp;
- event_func_t event_func;
+ /* event_func_t event_func; unused */
void* data;
union {
STRING* msg; /* for testing only */
int signal; /* for EVENT_TYPE_SIGNAL */
parrot_timer_event timer_event; /* for EVENT_TYPE_TIMER */
+ _call_back_info call_back; /* CALL_BACKs */
} u;
} parrot_event;
@@ -70,6 +78,8 @@
void Parrot_new_terminate_event(Parrot_Interp);
void disable_event_checking(Parrot_Interp);
void enable_event_checking(Parrot_Interp);
+
+void Parrot_new_cb_event(Parrot_Interp, PMC*sub, PMC*user, void*ext);
void Parrot_kill_event_loop(void);
void* Parrot_sleep_on_event(Parrot_Interp, FLOATVAL t, void* next);
1.119 +6 -1 parrot/include/parrot/interpreter.h
Index: interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.118
retrieving revision 1.119
diff -u -w -r1.118 -r1.119
--- interpreter.h 4 Feb 2004 21:15:57 -0000 1.118
+++ interpreter.h 7 Feb 2004 12:58:46 -0000 1.119
@@ -1,7 +1,7 @@
/* interpreter.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.h,v 1.118 2004/02/04 21:15:57 leo Exp $
+ * $Id: interpreter.h,v 1.119 2004/02/07 12:58:46 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -334,6 +334,11 @@
void Parrot_runops_fromc(Parrot_Interp, PMC *sub);
void Parrot_runops_fromc_save(Parrot_Interp, PMC *sub);
void* Parrot_runops_fromc_args(Parrot_Interp, PMC *sub, const char *sig, ...);
+void* Parrot_runops_fromc_args_save(Parrot_Interp, PMC *, const char *, ...);
+
+void Parrot_callback_C(void *external_data, PMC *callback_info);
+void Parrot_callback_D(PMC *callback_info, void *external_data);
+PMC* Parrot_make_cb(Parrot_Interp interpreter, PMC* sub, PMC* user_data);
typedef opcode_t *(*native_func_t)(struct Parrot_Interp * interpreter,
opcode_t * cur_opcode,
1.29 +33 -1 parrot/src/events.c
Index: events.c
===================================================================
RCS file: /cvs/public/parrot/src/events.c,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -w -r1.28 -r1.29
--- events.c 30 Jan 2004 12:09:25 -0000 1.28
+++ events.c 7 Feb 2004 12:58:53 -0000 1.29
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: events.c,v 1.28 2004/01/30 12:09:25 leo Exp $
+$Id: events.c,v 1.29 2004/02/07 12:58:53 leo Exp $
=head1 NAME
@@ -301,6 +301,7 @@
entry->type = QUEUE_ENTRY_TYPE_TIMED_EVENT;
insert_entry(event_queue, entry);
break;
+ case EVENT_TYPE_CALL_BACK:
case EVENT_TYPE_SIGNAL:
entry->type = QUEUE_ENTRY_TYPE_EVENT;
unshift_entry(event_queue, entry);
@@ -366,6 +367,28 @@
/*
=item C<void
+Parrot_new_cb_event(Parrot_Interp, PMC*sub, PMC*user, void*ext)>
+
+Prepare and schedul a callback event
+
+=cut
+
+*/
+
+void
+Parrot_new_cb_event(Parrot_Interp interpreter, PMC* sub, PMC* user, void* ext)
+{
+ parrot_event* ev = mem_sys_allocate(sizeof(parrot_event));
+ ev->type = EVENT_TYPE_CALL_BACK;
+ ev->u.call_back.sub = sub;
+ ev->u.call_back.user_data = user;
+ ev->u.call_back.external_data = ext;
+ Parrot_schedule_event(interpreter, ev);
+}
+
+/*
+
+=item C<void
Parrot_del_timer_event(Parrot_Interp interpreter, PMC* timer)>
Deactivate the timer identified by C<timer>.
@@ -453,6 +476,7 @@
/*
* sleep checks events when it awakes
*/
+ edebug((stderr, "got entry - schedule_inter_qentry %d\n", event->type));
if (event->type != EVENT_TYPE_SLEEP)
enable_event_checking(interpreter);
/*
@@ -463,6 +487,7 @@
* in front or at the end of the queue
*/
switch (event->type) {
+ case EVENT_TYPE_CALL_BACK:
case EVENT_TYPE_SIGNAL:
unshift_entry(interpreter->task_queue, entry);
break;
@@ -1015,6 +1040,13 @@
/* run ops, save registers */
Parrot_runops_fromc_save(interpreter,
event->u.timer_event.sub);
+ break;
+ case EVENT_TYPE_CALL_BACK:
+ edebug((stderr, "starting user cb\n"));
+ Parrot_runops_fromc_args(interpreter, event->u.call_back.sub,
+ "PP",
+ event->u.call_back.user_data,
+ event->u.call_back.external_data);
break;
case EVENT_TYPE_SLEEP:
break;
1.262 +225 -8 parrot/src/interpreter.c
Index: interpreter.c
===================================================================
RCS file: /cvs/public/parrot/src/interpreter.c,v
retrieving revision 1.261
retrieving revision 1.262
diff -u -w -r1.261 -r1.262
--- interpreter.c 4 Feb 2004 21:16:07 -0000 1.261
+++ interpreter.c 7 Feb 2004 12:58:53 -0000 1.262
@@ -1,7 +1,7 @@
/*
################################################################################
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: interpreter.c,v 1.261 2004/02/04 21:16:07 leo Exp $
+$Id: interpreter.c,v 1.262 2004/02/07 12:58:53 leo Exp $
################################################################################
=head1 NAME
@@ -1011,9 +1011,13 @@
Parrot_runops_fromc_args(Parrot_Interp interpreter, PMC *sub,
const char *sig, ...)>
+=item C<void *
+Parrot_runops_fromc_args_save(Parrot_Interp interpreter, PMC *sub,
+ const char *sig, ...)>
+
Run parrot ops, called from C code, function arguments are passed as
C<va_args> according to signature the C<sub> argument is an invocable
-C<Sub> PMC.
+C<Sub> PMC. The latter preserves registers.
Signatures are similar to NCI:
@@ -1029,11 +1033,9 @@
*/
-void *
-Parrot_runops_fromc_args(Parrot_Interp interpreter, PMC *sub,
- const char *sig, ...)
+static void *
+runops_args(Parrot_Interp interpreter, PMC *sub, const char* sig, va_list ap)
{
- va_list ap;
/* *sig is retval like in NCI */
int ret;
int next[4];
@@ -1050,7 +1052,7 @@
REG_INT(4) = 0; /* # of N params */
ret = *sig++;
- va_start(ap, sig);
+
while (*sig) {
switch (*sig++) {
case 'v': /* void func, no params */
@@ -1077,7 +1079,6 @@
sig[-1]);
}
}
- va_end(ap);
Parrot_runops_fromc(interpreter, sub);
/*
@@ -1101,6 +1102,222 @@
ret);
}
return retval;
+}
+
+void *
+Parrot_runops_fromc_args(Parrot_Interp interpreter, PMC *sub,
+ const char *sig, ...)
+{
+ va_list args;
+ void *ret;
+
+ va_start(args, sig);
+ ret = runops_args(interpreter, sub, sig, args);
+ va_end(args);
+ return ret;
+}
+
+void *
+Parrot_runops_fromc_args_save(Parrot_Interp interpreter, PMC *sub,
+ const char *sig, ...)
+{
+ struct regsave *data = save_regs(interpreter);
+ va_list args;
+
+ va_start(args, sig);
+ (void) runops_args(interpreter, sub, sig, args);
+ va_end(args);
+ restore_regs(interpreter, data);
+ return NULL;
+}
+
+/*
+
+=item C<PMC* Parrot_make_cb(Parrot_Interp interpreter, PMC* sub, PMC* user)>
+
+Register a callback function according to pdd16
+
+=cut
+
+*/
+
+PMC*
+Parrot_make_cb(Parrot_Interp interpreter, PMC* sub, PMC* user_data)
+{
+ PMC* interp_pmc;
+ /*
+ * we stuff all the information into the Sub PMC and pass that
+ * on to the external sub
+ */
+ interp_pmc = VTABLE_get_pmc_keyed_int(interpreter, interpreter->iglobals,
+ (INTVAL) IGLOBALS_INTERPRETER);
+ VTABLE_setprop(interpreter, sub,
+ string_make(interpreter, "_interpreter", 12, NULL,
+ PObj_external_FLAG, NULL), interp_pmc);
+ VTABLE_setprop(interpreter, sub,
+ string_make(interpreter, "_user_data", 10, NULL,
+ PObj_external_FLAG, NULL), user_data);
+ /*
+ * we are gonna passing this PMC to external code, the PMCs
+ * might get out of scope until the callback is called -
+ * we don't know, when the callback will be called
+ *
+ * so anchor the PMC
+ */
+ dod_register_pmc(interpreter, sub);
+
+ /*
+ * finally the external lib awaits a function pointer
+ * fake a PMC that points to Parrot_callback_C (or _D)
+ */
+
+ return F2DPTR(Parrot_callback_C);
+}
+
+/*
+
+=item C<static void verify_CD(void *external_data, PMC *callback_info)>
+
+Verify callback_info PMC then continue with callback_CD
+
+=cut
+
+*/
+
+static void callback_CD(Parrot_Interp, void *, PMC *callback_info);
+
+static void
+verify_CD(void *external_data, PMC *callback_info)
+{
+ Parrot_Interp interpreter = NULL;
+ size_t i;
+
+ /*
+ * 1.) callback_info is from external code so:
+ * verify that we get a PMC that is one that we have passed in
+ * as user data, when we prepared the callback
+ */
+
+ /* a NULL pointer or a pointer not aligned is very likely wrong */
+ if (!callback_info || ((UINTVAL)callback_info & 3))
+ PANIC("callback_info doesn't look like a pointer");
+
+ /*
+ * we don't have an interpreter yet, where this PMC might be
+ * located so run through interpreters and check their PMC pools
+ */
+ LOCK(interpreter_array_mutex);
+ for (i = 0; i < n_interpreters; ++i) {
+ if (interpreter_array[i] == NULL)
+ continue;
+ interpreter = interpreter_array[i];
+ if (interpreter)
+ if (contained_in_pool(interpreter,
+ interpreter->arena_base->pmc_pool, callback_info))
+ break;
+ }
+ UNLOCK(interpreter_array_mutex);
+ if (!interpreter)
+ PANIC("interpreter not found for callback");
+
+ /*
+ * now we should have the interpreter where that callback
+ * did originate - do some further checks on the PMC
+ */
+
+ /* if that doesn't look like a PMC we are still lost */
+ if (!PObj_is_PMC_TEST(callback_info))
+ PANIC("callback_info isn't a PMC");
+
+ /*
+ * 2) some more checks: callback info is a Sub PMC
+ * we have passed a Sub PMC as user_data so check that
+ */
+ if (!callback_info->vtable)
+ PANIC("callback_info hasn't a vtable");
+ if (callback_info->vtable->base_type != enum_class_Sub)
+ PANIC("callback_info isn't a Sub PMC");
+ /*
+ * ok fine till here
+ */
+ callback_CD(interpreter, external_data, callback_info);
+}
+
+/*
+
+=item C<static void
+callback_CD(Parrot_Interp, void *external_data, PMC *callback_info)>
+
+Common callback function handler s. pdd16
+
+=cut
+
+*/
+
+static void
+callback_CD(Parrot_Interp interpreter, void *external_data, PMC *callback_info)
+{
+
+ PMC *passed_interp; /* the interp that originated the CB */
+ PMC *user_data; /* user really intended to get that back */
+ int async = 1; /* cb is hitting this sub somewhen inmidst */
+ /*
+ * 3) extract user_data, func signature, check interpreter ...
+ */
+ passed_interp = VTABLE_getprop(interpreter, callback_info,
+ string_from_cstring(interpreter, "_interpreter", 0));
+ if (PMC_data(passed_interp) != interpreter)
+ PANIC("callback gone to wrong interpreter");
+ user_data = VTABLE_getprop(interpreter, callback_info,
+ string_from_cstring(interpreter, "_user_data", 0));
+ /*
+ * 4) check if the call_back is synchronous:
+ * - if yes we are inside the NCI call
+ * we could run the Sub immediately now (I think)
+ * - if no, and that's always safe, post a CALLBACK_EVENT
+ */
+
+ if (async) {
+ /*
+ * create a CB_EVENT, put Sub and data inside and finito
+ *
+ * *if* this function is finally no void, i.e. the calling
+ * C program awaits a return result from the callback,
+ * then wait for the CB_EVENT_xx to finish and return the
+ * result
+ */
+ Parrot_new_cb_event(interpreter, callback_info,
+ user_data, external_data);
+ }
+ else {
+ /*
+ * just call the sub
+ */
+ }
+}
+
+/*
+
+=item C<void Parrot_callback_C(void *external_data, PMC *callback_info)>
+
+=item C<void Parrot_callback_D(PMC *callback_info, void *external_data)>
+
+NCI callback functions s. ppd16
+
+=cut
+
+*/
+
+void
+Parrot_callback_C(void *external_data, PMC *callback_info)
+{
+ verify_CD(external_data, callback_info);
+}
+
+void
+Parrot_callback_D(PMC *callback_info, void *external_data)
+{
+ verify_CD(external_data, callback_info);
}
/*
1.20 +14 -0 parrot/src/nci_test.c
Index: nci_test.c
===================================================================
RCS file: /cvs/public/parrot/src/nci_test.c,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -w -r1.19 -r1.20
--- nci_test.c 6 Feb 2004 10:57:37 -0000 1.19
+++ nci_test.c 7 Feb 2004 12:58:53 -0000 1.20
@@ -20,6 +20,9 @@
void * nci_pi(int test);
void nci_vP(void *pmc);
+typedef void (*cb_C1_func)(const char*, void*);
+void nci_cb_C1(cb_C1_func, void*);
+
double nci_dd(double d) {
return d * 2.0;
}
@@ -220,6 +223,17 @@
puts("ok");
else
puts("got null");
+}
+
+/*
+ * pdd16 tests
+ */
+void
+nci_cb_C1(cb_C1_func cb, void* user_data)
+{
+ const char *result = "succeded";
+ /* call the cb synchronously */
+ (cb)(result, user_data);
}
#ifdef TEST
1.28 +61 -1 parrot/t/pmc/nci.t
Index: nci.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/nci.t,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -w -r1.27 -r1.28
--- nci.t 6 Feb 2004 11:49:51 -0000 1.27
+++ nci.t 7 Feb 2004 12:58:59 -0000 1.28
@@ -1,4 +1,4 @@
-use Parrot::Test tests => 26;
+use Parrot::Test tests => 27;
use Parrot::Config;
print STDERR $PConfig{jitcpuarch}, " JIT CPU\n";
@@ -821,6 +821,66 @@
CODE
ok
got null
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "nci_cb_C1");
+ bounds 1 # no JIT yet
+ sweepoff # SEGV in dynext.c:235
+ # we need a flag if the call_back is already done
+ new P10, .PerlInt
+ store_global "cb_done", P10
+ # first attempt - create cb manually (this step will be hidden later)
+ newsub P5, .Sub, _call_back
+ null P1
+ dlfunc P0, P1, "Parrot_make_cb", "PIPP"
+ print "ok 1\n"
+ # prepare user data
+ new P6, .PerlInt
+ set P6, 42
+ # preserve the Sub
+ set P7, P5
+ # create callback (=> P5)
+ invoke
+ # now call the external sub, that takes a call_back and user_data
+ loadlib P1, "libnci"
+ dlfunc P0, P1, "nci_cb_C1", "vPP"
+ print "ok 2\n"
+ # P5 is the cb
+ # get user_data i.e. the Sub
+ set P6, P7
+ invoke
+ # call_back will be called at any time
+ # so spin a bit
+ set I20, 0
+loop:
+ inc I20
+ ## sleep 0.1 hangs sometimes in __select ## XXX ##
+ find_global P11, "cb_done"
+ if P11, fin
+ gt I20, 100000, err
+ branch loop
+fin:
+ print "done.\n"
+ end
+err:
+ print "cb didnt run\n"
+ end
+
+_call_back:
+ print "in callback\n"
+ print "user data: "
+ print P5
+ print "\n"
+ find_global P12, "cb_done"
+ inc P12
+ invoke P1
+
+CODE
+ok 1
+ok 2
+in callback
+user data: 42
+done.
OUTPUT
} # SKIP
