cvsuser 04/10/28 05:13:32
Modified: include/parrot extend.h interpreter.h
src extend.c inter_run.c
t/src extend.t
Log:
changed extend.c:Parrot_call
Revision Changes Path
1.21 +12 -3 parrot/include/parrot/extend.h
Index: extend.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/extend.h,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- extend.h 18 Oct 2004 01:35:25 -0000 1.20
+++ extend.h 28 Oct 2004 12:13:30 -0000 1.21
@@ -1,7 +1,7 @@
/* extend.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: extend.h,v 1.20 2004/10/18 01:35:25 brentdax Exp $
+ * $Id: extend.h,v 1.21 2004/10/28 12:13:30 leo Exp $
* Overview:
* This is the Parrot extension mechanism, the face we present to
* extension modules and whatnot
@@ -91,8 +91,17 @@
void Parrot_free_cstring(char *);
-void Parrot_call(Parrot_INTERP, Parrot_PMC, Parrot_Int, ...);
-void Parrot_call_method(Parrot_INTERP, Parrot_PMC, Parrot_STRING, Parrot_Int, ...);
+void * Parrot_call_sub(Parrot_INTERP, Parrot_PMC, const char *, ...);
+Parrot_Int Parrot_call_sub_ret_int(Parrot_INTERP, Parrot_PMC,
+ const char *, ...);
+Parrot_Float Parrot_call_sub_ret_float(Parrot_INTERP, Parrot_PMC,
+ const char *, ...);
+void * Parrot_call_method(Parrot_INTERP, Parrot_PMC,
+ Parrot_PMC, Parrot_STRING, const char *, ...);
+Parrot_Int Parrot_call_method_ret_int(Parrot_INTERP, Parrot_PMC,
+ Parrot_PMC, Parrot_STRING, const char *, ...);
+Parrot_Float Parrot_call_method_ret_float(Parrot_INTERP, Parrot_PMC,
+ Parrot_PMC, Parrot_STRING, const char *, ...);
Parrot_Int Parrot_get_intreg(Parrot_INTERP, Parrot_Int);
Parrot_Float Parrot_get_numreg(Parrot_INTERP, Parrot_Int);
1.158 +11 -1 parrot/include/parrot/interpreter.h
Index: interpreter.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/interpreter.h,v
retrieving revision 1.157
retrieving revision 1.158
diff -u -r1.157 -r1.158
--- interpreter.h 28 Oct 2004 11:24:35 -0000 1.157
+++ interpreter.h 28 Oct 2004 12:13:30 -0000 1.158
@@ -1,7 +1,7 @@
/* interpreter.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: interpreter.h,v 1.157 2004/10/28 11:24:35 leo Exp $
+ * $Id: interpreter.h,v 1.158 2004/10/28 12:13:30 leo Exp $
* Overview:
* The interpreter api handles running the operations
* Data Structure and Algorithms:
@@ -388,6 +388,9 @@
FLOATVAL Parrot_runops_fromc_args_retf(Interp *, PMC *, const char *, ...);
void* Parrot_runops_fromc_arglist(Interp *, PMC *, const char *sig, va_list);
+INTVAL Parrot_runops_fromc_arglist_reti(Interp *, PMC *, const char *, va_list);
+FLOATVAL Parrot_runops_fromc_arglist_retf(Interp *, PMC *, const char *,
+ va_list);
void* Parrot_run_meth_fromc(Interp *, PMC *sub, PMC* obj, STRING *meth);
void* Parrot_run_meth_fromc_args(Interp *, PMC *sub,
@@ -397,6 +400,13 @@
FLOATVAL Parrot_run_meth_fromc_args_retf(Interp *, PMC *sub,
PMC* obj, STRING *meth, const char *signature, ...);
+void* Parrot_run_meth_fromc_arglist(Interp *, PMC *sub,
+ PMC* obj, STRING *meth, const char *signature, va_list);
+INTVAL Parrot_run_meth_fromc_arglist_reti(Interp *, PMC *sub,
+ PMC* obj, STRING *meth, const char *signature, va_list);
+FLOATVAL Parrot_run_meth_fromc_arglist_retf(Interp *, PMC *sub,
+ PMC* obj, STRING *meth, const char *signature, va_list);
+
void Parrot_callback_C(void *external_data, PMC *callback_info);
void Parrot_callback_D(PMC *callback_info, void *external_data);
PMC* Parrot_make_cb(Interp * interpreter, PMC* sub, PMC* user_data,
1.31 +123 -41 parrot/src/extend.c
Index: extend.c
===================================================================
RCS file: /cvs/public/parrot/src/extend.c,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- extend.c 28 Oct 2004 07:59:26 -0000 1.30
+++ extend.c 28 Oct 2004 12:13:31 -0000 1.31
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: extend.c,v 1.30 2004/10/28 07:59:26 leo Exp $
+$Id: extend.c,v 1.31 2004/10/28 12:13:31 leo Exp $
=head1 NAME
@@ -632,71 +632,153 @@
/*
-=item C<void
-Parrot_call(Parrot_INTERP interpreter, Parrot_PMC sub,
- Parrot_Int argcount, ...)>
+=item C<void*
+Parrot_call_sub(Parrot_INTERP interpreter, Parrot_PMC sub,
+ const char *signature, ...)>
+
+Call a parrot subroutine the given function signature. The first char in
+C<signature> denotes the return value. Next chars are arguments.
+
+The return value of this function can be void or a pointer type.
+
+Signature chars are:
+
+ v ... void return
+ I ... Parrot_Int
+ N ... Parrot_Float
+ S ... Parrot_STRING
+ P ... Parrot_PMC
+
+=item C<Parrot_Int>
+Parrot_call_sub_ret_int(Parrot_INTERP interpreter, Parrot_PMC sub,
+ const char *signature, ...)>
+
+=item C<Parrot_Float>
+Parrot_call_sub_ret_float(Parrot_INTERP interpreter, Parrot_PMC sub,
+ const char *signature, ...)>
-Call a parrot subroutine, with PMC parameters.
+Like above, with Parrot_Int or Parrot_Float return result.
=cut
*/
-void Parrot_call(Parrot_INTERP interpreter, Parrot_PMC sub,
- Parrot_Int argcount, ...) {
- Parrot_Int inreg = 0;
+void*
+Parrot_call_sub(Parrot_INTERP interpreter, Parrot_PMC sub,
+ const char *signature, ...)
+{
va_list ap;
+ void *result;
+
PARROT_CALLIN_START(interpreter);
- va_start(ap, argcount);
+ va_start(ap, signature);
+ result = Parrot_runops_fromc_arglist(interpreter, sub, signature, ap);
+ va_end(ap);
+
+ PARROT_CALLIN_END(interpreter);
+ return result;
+}
+
+Parrot_Int
+Parrot_call_sub_ret_int(Parrot_INTERP interpreter, Parrot_PMC sub,
+ const char *signature, ...)
+{
+ va_list ap;
+ Parrot_Int result;
- /* Will all the arguments fit into registers? */
- REG_INT(0) = 0;
- if (argcount < 12) {
- REG_INT(3) = argcount;
- for (inreg = 0; inreg < argcount; inreg++) {
- REG_PMC(inreg + 5) = va_arg(ap, Parrot_PMC);
- }
- } else {
- /* Nope, so we need an overflow array */
- Parrot_PMC overflow;
- Parrot_Int ocount;
- REG_INT(3) = 11;
- REG_PMC(3) = overflow = Parrot_PMC_new(interpreter,
- Parrot_PMC_typenum(interpreter, "Array"));
- Parrot_PMC_set_intval(interpreter, overflow, argcount - 11);
- for (inreg = 0; inreg < 11; inreg++) {
- REG_PMC(inreg + 5) = va_arg(ap, Parrot_PMC);
- }
- for (ocount = 0; ocount < argcount - 11; ocount++) {
- VTABLE_set_pmc_keyed_int(interpreter, overflow, ocount,
- (Parrot_PMC)va_arg(ap, Parrot_PMC));
- }
- }
+ PARROT_CALLIN_START(interpreter);
+
+ va_start(ap, signature);
+ result = Parrot_runops_fromc_arglist_reti(interpreter, sub, signature, ap);
va_end(ap);
- Parrot_runops_fromc(interpreter, sub);
PARROT_CALLIN_END(interpreter);
+ return result;
+}
+
+Parrot_Float
+Parrot_call_sub_ret_float(Parrot_INTERP interpreter, Parrot_PMC sub,
+ const char *signature, ...)
+{
+ va_list ap;
+ Parrot_Float result;
+
+ PARROT_CALLIN_START(interpreter);
+
+ va_start(ap, signature);
+ result = Parrot_runops_fromc_arglist_retf(interpreter, sub, signature, ap);
+ va_end(ap);
+ PARROT_CALLIN_END(interpreter);
+ return result;
}
/*
-=item C<void Parrot_call_method(Parrot_INTERP interp, Parrot_PMC sub,
- Parrot_STRING method, Parrot_Int argcount, ...)>
+=item C<void* Parrot_call_method(Parrot_INTERP interp, Parrot_PMC sub,
+ Parrot_PMC object, Parrot_STRING method, const char *signature, ...)>
+
+=item C<Parrot_Int Parrot_call_method_ret_int(Parrot_INTERP interp,
+ Parrot_PMC sub, Parrot_PMC object, Parrot_STRING method,
+ const char *signature, ...)>
-Call a parrot method, with PMC parameters.
+=item C<Parrot_Float Parrot_call_method_ret_float(Parrot_INTERP interp,
+ Parrot_PMC sub, Parrot_PMC object, Parrot_STRING method,
+ const char *signature, ...)>
-XXX Not implemented yet.
+Call a parrot method for the given object.
=cut
*/
-void Parrot_call_method(Parrot_INTERP interp, Parrot_PMC sub,
- Parrot_STRING method, Parrot_Int argcount, ...) {
- PARROT_CALLIN_START(interp);
- PARROT_CALLIN_END(interp);
+void *
+Parrot_call_method(Parrot_INTERP interpreter, Parrot_PMC sub, Parrot_PMC obj,
+ Parrot_STRING method, const char *signature, ...)
+{
+ void *result;
+ va_list ap;
+
+ PARROT_CALLIN_START(interpreter);
+ va_start(ap, signature);
+ result = Parrot_run_meth_fromc_arglist(interpreter, sub,
+ obj, method, signature, ap);
+ va_end(ap);
+ PARROT_CALLIN_END(interpreter);
+ return result;
+}
+
+Parrot_Int
+Parrot_call_method_ret_int(Parrot_INTERP interpreter, Parrot_PMC sub,
+ Parrot_PMC obj, Parrot_STRING method, const char *signature, ...)
+{
+ Parrot_Int result;
+ va_list ap;
+
+ PARROT_CALLIN_START(interpreter);
+ va_start(ap, signature);
+ result = Parrot_run_meth_fromc_arglist_reti(interpreter, sub,
+ obj, method, signature, ap);
+ va_end(ap);
+ PARROT_CALLIN_END(interpreter);
+ return result;
+}
+
+Parrot_Float
+Parrot_call_method_ret_float(Parrot_INTERP interpreter, Parrot_PMC sub,
+ Parrot_PMC obj, Parrot_STRING method, const char *signature, ...)
+{
+ Parrot_Float result;
+ va_list ap;
+
+ PARROT_CALLIN_START(interpreter);
+ va_start(ap, signature);
+ result = Parrot_run_meth_fromc_arglist_retf(interpreter, sub,
+ obj, method, signature, ap);
+ va_end(ap);
+ PARROT_CALLIN_END(interpreter);
+ return result;
}
/*
1.14 +50 -0 parrot/src/inter_run.c
Index: inter_run.c
===================================================================
RCS file: /cvs/public/parrot/src/inter_run.c,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- inter_run.c 28 Oct 2004 11:24:38 -0000 1.13
+++ inter_run.c 28 Oct 2004 12:13:31 -0000 1.14
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: inter_run.c,v 1.13 2004/10/28 11:24:38 leo Exp $
+$Id: inter_run.c,v 1.14 2004/10/28 12:13:31 leo Exp $
=head1 NAME
@@ -432,6 +432,56 @@
return set_retval(interpreter, *sig, bp);
}
+INTVAL
+Parrot_runops_fromc_arglist_reti(Parrot_Interp interpreter, PMC *sub,
+ const char *sig, va_list args)
+{
+ struct parrot_regs_t *bp;
+
+ bp = runops_args(interpreter, sub, PMCNULL, NULL, sig, args);
+ return set_retval_i(interpreter, *sig, bp);
+}
+
+FLOATVAL
+Parrot_runops_fromc_arglist_retf(Parrot_Interp interpreter, PMC *sub,
+ const char *sig, va_list args)
+{
+ struct parrot_regs_t *bp;
+
+ bp = runops_args(interpreter, sub, PMCNULL, NULL, sig, args);
+ return set_retval_f(interpreter, *sig, bp);
+}
+
+void*
+Parrot_run_meth_fromc_arglist(Parrot_Interp interpreter,
+ PMC *sub, PMC *obj, STRING *meth, const char *sig, va_list args)
+{
+ struct parrot_regs_t *bp;
+
+ bp = runops_args(interpreter, sub, obj, meth, sig, args);
+ return set_retval(interpreter, *sig, bp);
+}
+
+INTVAL
+Parrot_run_meth_fromc_arglist_reti(Parrot_Interp interpreter,
+ PMC *sub, PMC *obj, STRING *meth, const char *sig, va_list args)
+{
+ struct parrot_regs_t *bp;
+
+ bp = runops_args(interpreter, sub, obj, meth, sig, args);
+ return set_retval_i(interpreter, *sig, bp);
+}
+
+FLOATVAL
+Parrot_run_meth_fromc_arglist_retf(Parrot_Interp interpreter,
+ PMC *sub, PMC *obj, STRING *meth, const char *sig, va_list args)
+{
+ struct parrot_regs_t *bp;
+
+ bp = runops_args(interpreter, sub, obj, meth, sig, args);
+ return set_retval_f(interpreter, *sig, bp);
+}
+
/*
=back
1.28 +4 -4 parrot/t/src/extend.t
Index: extend.t
===================================================================
RCS file: /cvs/public/parrot/t/src/extend.t,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -r1.27 -r1.28
--- extend.t 1 Oct 2004 21:16:55 -0000 1.27
+++ extend.t 28 Oct 2004 12:13:32 -0000 1.28
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: extend.t,v 1.27 2004/10/01 21:16:55 jrieks Exp $
+# $Id: extend.t,v 1.28 2004/10/28 12:13:32 leo Exp $
# Tests the extension API
=head1 NAME
@@ -439,7 +439,7 @@
key = key_new_cstring(interpreter, "_sub1");
sub = VTABLE_get_pmc_keyed(interpreter,
interpreter->globals->stash_hash, key);
- Parrot_call(interpreter, sub, 0);
+ Parrot_call_sub(interpreter, sub, "v");
PIO_eprintf(interpreter, "back\n");
/* win32 seems to buffer stderr ? */
@@ -451,7 +451,7 @@
arg = pmc_new(interpreter, enum_class_PerlString);
VTABLE_set_string_native(interpreter, arg,
string_from_cstring(interpreter, "hello ", 0));
- Parrot_call(interpreter, sub, 1, arg);
+ Parrot_call_sub(interpreter, sub, "vP", arg);
PIO_eprintf(interpreter, "back\n");
return NULL;
@@ -520,7 +520,7 @@
}
else {
push_new_c_exception_handler(interpreter, &jb);
- Parrot_call(interpreter, sub, 0);
+ Parrot_call_sub(interpreter, sub, "v");
}
PIO_eprintf(interpreter, "back\n");
