[svn:parrot] r36595 - in trunk: . config/gen/makefiles include/parrot src src/call
allison at svn.parrot.org
allison at svn.parrot.org
Wed Feb 11 20:42:58 UTC 2009
Author: allison
Date: Wed Feb 11 20:42:56 2009
New Revision: 36595
URL: https://trac.parrot.org/parrot/changeset/36595
Log:
[pcc] Merging the kill_pccinvoke branch into trunk for r36508 to r36588. Simple
file restructuring for greater maintenance sanity.
Added:
trunk/include/parrot/call.h (contents, props changed)
- copied, changed from r36591, trunk/include/parrot/inter_call.h
trunk/src/call/
trunk/src/call/ops.c (contents, props changed)
- copied, changed from r36591, trunk/src/inter_run.c
trunk/src/call/pcc.c (contents, props changed)
- copied, changed from r36591, trunk/src/inter_call.c
Deleted:
trunk/include/parrot/inter_call.h
trunk/src/inter_call.c
trunk/src/inter_run.c
Modified:
trunk/MANIFEST
trunk/config/gen/makefiles/root.in
trunk/include/parrot/interpreter.h
trunk/include/parrot/multidispatch.h
trunk/include/parrot/parrot.h
trunk/src/multidispatch.c
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST Wed Feb 11 20:23:35 2009 (r36594)
+++ trunk/MANIFEST Wed Feb 11 20:42:56 2009 (r36595)
@@ -898,6 +898,7 @@
include/parrot/atomic/gcc_x86.h [main]include
include/parrot/atomic/sparc.h [main]include
include/parrot/caches.h [main]include
+include/parrot/call.h [main]include
include/parrot/cclass.h [main]include
include/parrot/charset.h [main]include
include/parrot/compiler.h [main]include
@@ -920,7 +921,6 @@
include/parrot/hash.h [main]include
include/parrot/hll.h [main]include
include/parrot/imcc.h [main]include
-include/parrot/inter_call.h [main]include
include/parrot/interpreter.h [main]include
include/parrot/io.h [main]include
include/parrot/io_portable.h [main]include
@@ -2528,6 +2528,8 @@
src/atomic/gcc_x86.c []
src/atomic/sparc_v9.s []
src/byteorder.c []
+src/call/ops.c []
+src/call/pcc.c []
src/datatypes.c []
src/debug.c []
src/dynext.c []
@@ -2569,11 +2571,9 @@
src/global_setup.c []
src/hash.c []
src/hll.c []
-src/inter_call.c []
src/inter_cb.c []
src/inter_create.c []
src/inter_misc.c []
-src/inter_run.c []
src/interp_guts.h []
src/interpreter.c []
src/io/api.c []
Modified: trunk/config/gen/makefiles/root.in
==============================================================================
--- trunk/config/gen/makefiles/root.in Wed Feb 11 20:23:35 2009 (r36594)
+++ trunk/config/gen/makefiles/root.in Wed Feb 11 20:42:56 2009 (r36595)
@@ -395,12 +395,12 @@
$(SRC_DIR)/global_setup$(O) \
$(SRC_DIR)/hash$(O) \
$(SRC_DIR)/hll$(O) \
- $(SRC_DIR)/inter_call$(O) \
+ $(SRC_DIR)/call/pcc$(O) \
$(SRC_DIR)/inter_cb$(O) \
$(SRC_DIR)/inter_create$(O) \
$(SRC_DIR)/inter_misc$(O) \
$(SRC_DIR)/interpreter$(O) \
- $(SRC_DIR)/inter_run$(O) \
+ $(SRC_DIR)/call/ops$(O) \
$(SRC_DIR)/key$(O) \
$(SRC_DIR)/library$(O) \
$(SRC_DIR)/list$(O) \
@@ -572,7 +572,7 @@
$(SRC_DIR)/global.str \
$(SRC_DIR)/global_setup.str \
$(SRC_DIR)/hll.str \
- $(SRC_DIR)/inter_call.str \
+ $(SRC_DIR)/call/pcc.str \
$(SRC_DIR)/inter_cb.str \
$(SRC_DIR)/inter_create.str \
$(SRC_DIR)/inter_misc.str \
@@ -1084,8 +1084,8 @@
$(SRC_DIR)/interpreter$(O) : $(SRC_DIR)/interpreter.c $(GENERAL_H_FILES)
-$(SRC_DIR)/inter_call$(O) : $(SRC_DIR)/inter_call.c $(GENERAL_H_FILES) \
- $(SRC_DIR)/inter_call.str $(SRC_DIR)/pmc/pmc_fixedintegerarray.h
+$(SRC_DIR)/call/pcc$(O) : $(SRC_DIR)/call/pcc.c $(GENERAL_H_FILES) \
+ $(SRC_DIR)/call/pcc.str $(SRC_DIR)/pmc/pmc_fixedintegerarray.h
$(SRC_DIR)/inter_cb$(O) : $(SRC_DIR)/inter_cb.c $(GENERAL_H_FILES) \
$(SRC_DIR)/inter_cb.str
@@ -1096,7 +1096,7 @@
$(SRC_DIR)/inter_create$(O) : $(SRC_DIR)/inter_create.c $(GENERAL_H_FILES) \
$(SRC_DIR)/inter_create.str
-$(SRC_DIR)/inter_run$(O) : $(SRC_DIR)/inter_run.c $(GENERAL_H_FILES)
+$(SRC_DIR)/call/ops$(O) : $(SRC_DIR)/call/ops.c $(GENERAL_H_FILES)
$(IO_DIR)/api$(O) : $(GENERAL_H_FILES) $(IO_DIR)/io_private.h $(IO_DIR)/api.str
Copied and modified: trunk/include/parrot/call.h (from r36591, trunk/include/parrot/inter_call.h)
==============================================================================
--- trunk/include/parrot/inter_call.h Wed Feb 11 20:04:17 2009 (r36591, copy source)
+++ trunk/include/parrot/call.h Wed Feb 11 20:42:56 2009 (r36595)
@@ -1,4 +1,4 @@
-/* inter_call.h
+/* call.h
* Copyright (C) 2001-2008, The Perl Foundation.
* SVN Info
* $Id$
@@ -88,10 +88,20 @@
PARROT_PASS_RESULTS = 0x01
} arg_pass_t;
-/* HEADERIZER BEGIN: src/inter_call.c */
+/* HEADERIZER BEGIN: src/call/pcc.c */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+PMC* Parrot_pcc_build_sig_object_from_varargs(PARROT_INTERP,
+ ARGIN_NULLOK(PMC* obj),
+ ARGIN(const char *sig),
+ va_list args)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(3);
+
+PARROT_EXPORT
void Parrot_convert_arg(PARROT_INTERP, ARGMOD(call_state *st))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
@@ -268,6 +278,10 @@
__attribute__nonnull__(1)
__attribute__nonnull__(3);
+#define ASSERT_ARGS_Parrot_pcc_build_sig_object_from_varargs \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sig)
#define ASSERT_ARGS_Parrot_convert_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(st)
@@ -350,7 +364,282 @@
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(ctx)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: src/inter_call.c */
+/* HEADERIZER END: src/call/pcc.c */
+
+/* HEADERIZER BEGIN: src/call/ops.c */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+PARROT_EXPORT
+void free_runloop_jump_point(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void new_runloop_jump_point(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
+PARROT_CAN_RETURN_NULL
+void * Parrot_run_meth_fromc(PARROT_INTERP,
+ ARGIN(PMC *sub),
+ ARGIN_NULLOK(PMC *obj),
+ SHIM(STRING *meth))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
+PARROT_CAN_RETURN_NULL
+void* Parrot_run_meth_fromc_arglist(PARROT_INTERP,
+ ARGIN(PMC *sub),
+ ARGIN_NULLOK(PMC *obj),
+ ARGIN(STRING *meth),
+ ARGIN(const char *sig),
+ va_list args)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(4)
+ __attribute__nonnull__(5);
+
+PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
+FLOATVAL Parrot_run_meth_fromc_arglist_retf(PARROT_INTERP,
+ ARGIN(PMC *sub),
+ ARGIN_NULLOK(PMC *obj),
+ ARGIN(STRING *meth),
+ ARGIN(const char *sig),
+ va_list args)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(4)
+ __attribute__nonnull__(5);
+
+PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
+PARROT_CAN_RETURN_NULL
+INTVAL Parrot_run_meth_fromc_arglist_reti(PARROT_INTERP,
+ ARGIN(PMC *sub),
+ ARGIN_NULLOK(PMC *obj),
+ ARGIN(STRING *meth),
+ ARGIN(const char *sig),
+ va_list args)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(4)
+ __attribute__nonnull__(5);
+
+PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
+PARROT_CAN_RETURN_NULL
+void* Parrot_run_meth_fromc_args(PARROT_INTERP,
+ ARGIN(PMC *sub),
+ ARGIN_NULLOK(PMC *obj),
+ ARGIN(STRING *meth),
+ ARGIN(const char *sig),
+ ...)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(4)
+ __attribute__nonnull__(5);
+
+PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
+FLOATVAL Parrot_run_meth_fromc_args_retf(PARROT_INTERP,
+ ARGIN(PMC *sub),
+ ARGIN_NULLOK(PMC *obj),
+ ARGIN(STRING *meth),
+ ARGIN(const char *sig),
+ ...)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(4)
+ __attribute__nonnull__(5);
+
+PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
+INTVAL Parrot_run_meth_fromc_args_reti(PARROT_INTERP,
+ ARGIN(PMC *sub),
+ ARGIN_NULLOK(PMC *obj),
+ ARGIN(STRING *meth),
+ ARGIN(const char *sig),
+ ...)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(4)
+ __attribute__nonnull__(5);
+
+PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
+PARROT_CANNOT_RETURN_NULL
+Parrot_Context * Parrot_runops_fromc(PARROT_INTERP, ARGIN(PMC *sub))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
+PARROT_CAN_RETURN_NULL
+void * Parrot_runops_fromc_arglist(PARROT_INTERP,
+ ARGIN(PMC *sub),
+ ARGIN(const char *sig),
+ va_list args)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
+FLOATVAL Parrot_runops_fromc_arglist_retf(PARROT_INTERP,
+ ARGIN(PMC *sub),
+ ARGIN(const char *sig),
+ va_list args)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
+INTVAL Parrot_runops_fromc_arglist_reti(PARROT_INTERP,
+ ARGIN(PMC *sub),
+ ARGIN(const char *sig),
+ va_list args)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
+PARROT_CAN_RETURN_NULL
+PMC * Parrot_runops_fromc_args(PARROT_INTERP,
+ ARGIN(PMC *sub),
+ ARGIN(const char *sig),
+ ...)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
+PARROT_CAN_RETURN_NULL
+void * Parrot_runops_fromc_args_event(PARROT_INTERP,
+ ARGIN(PMC *sub),
+ ARGIN(const char *sig),
+ ...)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
+FLOATVAL Parrot_runops_fromc_args_retf(PARROT_INTERP,
+ ARGIN(PMC *sub),
+ ARGIN(const char *sig),
+ ...)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
+INTVAL Parrot_runops_fromc_args_reti(PARROT_INTERP,
+ ARGIN(PMC *sub),
+ ARGIN(const char *sig),
+ ...)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+void destroy_runloop_jump_points(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+void really_destroy_runloop_jump_points(
+ ARGIN_NULLOK(Parrot_runloop *jump_point));
+
+void runops(PARROT_INTERP, size_t offs)
+ __attribute__nonnull__(1);
+
+#define ASSERT_ARGS_free_runloop_jump_point __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_new_runloop_jump_point __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_run_meth_fromc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sub)
+#define ASSERT_ARGS_Parrot_run_meth_fromc_arglist __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sub) \
+ || PARROT_ASSERT_ARG(meth) \
+ || PARROT_ASSERT_ARG(sig)
+#define ASSERT_ARGS_Parrot_run_meth_fromc_arglist_retf \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sub) \
+ || PARROT_ASSERT_ARG(meth) \
+ || PARROT_ASSERT_ARG(sig)
+#define ASSERT_ARGS_Parrot_run_meth_fromc_arglist_reti \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sub) \
+ || PARROT_ASSERT_ARG(meth) \
+ || PARROT_ASSERT_ARG(sig)
+#define ASSERT_ARGS_Parrot_run_meth_fromc_args __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sub) \
+ || PARROT_ASSERT_ARG(meth) \
+ || PARROT_ASSERT_ARG(sig)
+#define ASSERT_ARGS_Parrot_run_meth_fromc_args_retf \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sub) \
+ || PARROT_ASSERT_ARG(meth) \
+ || PARROT_ASSERT_ARG(sig)
+#define ASSERT_ARGS_Parrot_run_meth_fromc_args_reti \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sub) \
+ || PARROT_ASSERT_ARG(meth) \
+ || PARROT_ASSERT_ARG(sig)
+#define ASSERT_ARGS_Parrot_runops_fromc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sub)
+#define ASSERT_ARGS_Parrot_runops_fromc_arglist __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sub) \
+ || PARROT_ASSERT_ARG(sig)
+#define ASSERT_ARGS_Parrot_runops_fromc_arglist_retf \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sub) \
+ || PARROT_ASSERT_ARG(sig)
+#define ASSERT_ARGS_Parrot_runops_fromc_arglist_reti \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sub) \
+ || PARROT_ASSERT_ARG(sig)
+#define ASSERT_ARGS_Parrot_runops_fromc_args __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sub) \
+ || PARROT_ASSERT_ARG(sig)
+#define ASSERT_ARGS_Parrot_runops_fromc_args_event \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sub) \
+ || PARROT_ASSERT_ARG(sig)
+#define ASSERT_ARGS_Parrot_runops_fromc_args_retf __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sub) \
+ || PARROT_ASSERT_ARG(sig)
+#define ASSERT_ARGS_Parrot_runops_fromc_args_reti __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(sub) \
+ || PARROT_ASSERT_ARG(sig)
+#define ASSERT_ARGS_destroy_runloop_jump_points __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_really_destroy_runloop_jump_points \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
+#define ASSERT_ARGS_runops __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: src/call/ops.c */
#define ASSERT_SIG_PMC(sig) \
PARROT_ASSERT(PObj_is_PMC_TEST(sig)); \
Deleted: trunk/include/parrot/inter_call.h
==============================================================================
--- trunk/include/parrot/inter_call.h Wed Feb 11 20:42:56 2009 (r36594)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,378 +0,0 @@
-/* inter_call.h
- * Copyright (C) 2001-2008, The Perl Foundation.
- * SVN Info
- * $Id$
- * Overview:
- * Data Structure and Algorithms:
- * Call argument handling.
- * History:
- * Initial version by leo on 2005/07/22
- * Major changes by mdiep in April 2007
- * Notes:
- * References:
- * pdd03 - Calling Conventions
- */
-
-#ifndef PARROT_INTER_CALL_H_GUARD
-#define PARROT_INTER_CALL_H_GUARD
-
-typedef enum call_state_mode {
- /* argument fetching/putting modes */
- CALL_STATE_SIG = 0x100, /* runops, nci. In case we're interfacing with
- C and va_lists. */
- CALL_STATE_OP = 0x200, /* get_, set_ ops. In case we're interfacing
- with Parrot code and get the signature from
- call_state_item.u.op. */
- CALL_S_D_MASK = 0x300, /* src/dest mask */
-
- CALL_STATE_FLATTEN = 0x400 /* whether we are busy in a :flat argument */
-} call_state_mode;
-
-typedef struct call_state_item {
- /* We have one call_state_item for both the caller (source,
- arguments/returns) and the callee (destination, parameters/results). */
- int mode; /* this specifies:
- - where we get our arguments from / where we put
- our parameters (from C code or from set_*,get_*)
- - if we're in the middle of a :flat */
-
- union {
- struct { /* In case the caller (or callee? FIXME) is C */
- void *ap; /* a ptr to va_list */
- const char *sig; /* C string describing the type of each argument */
- } sig;
-
- struct { /* In case the caller/callee was Parrot code: */
- opcode_t *pc; /* array of 'indexes' for each argument:
- - if it's a constant, the constant number
- - if it's a register, the register number */
- PMC *signature; /* a PMC array holding a Call_bits_enum_t
- signature for each argument */
- } op;
- } u;
-
- Parrot_Context *ctx; /* the source or destination context */
- INTVAL used; /* src: whether this argument has been consumed
- * (or: whether the previous arg has?) */
- INTVAL i; /* number of args/params already processed */
- INTVAL n; /* number of args/params to match.
- * may include :slurpys and :flats */
- INTVAL sig; /* type of current arg/param
- * (counting from 1, the i'th) */
-
- /* We might encounter a :flat. */
- /* FIXME bgeron: is this used for :slurpys?
- * I can't find a reference in slurpy-filling code. */
-
- PMC *slurp; /* PMC in which to put the args we slurp up
- * or source from where to flatten */
- INTVAL slurp_i; /* index of :flat/:slurpy arg/param to match */
- INTVAL slurp_n; /* number of :flat/:slurpy args/params to match */
-} call_state_item;
-
-typedef struct call_state {
- call_state_item src;
- call_state_item dest;
- UnionVal val;
- int n_actual_args; /* arguments incl. flatten */
- int optionals; /* sum of optionals */
- int params; /* sum of params */
- int first_named; /* param idx of 1st named */
- UINTVAL named_done; /* bit mask, 1 if named was assigned */
- STRING *name; /* name of argument if any */
- PMC *key; /* to iterate a flattening hash */
-} call_state;
-
-typedef enum arg_pass_t {
- PARROT_PASS_PARAMS = 0x00,
- PARROT_PASS_RESULTS = 0x01
-} arg_pass_t;
-
-/* HEADERIZER BEGIN: src/inter_call.c */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-PARROT_EXPORT
-void Parrot_convert_arg(PARROT_INTERP, ARGMOD(call_state *st))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-PARROT_EXPORT
-int Parrot_fetch_arg(PARROT_INTERP, ARGMOD(call_state *st))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-PARROT_EXPORT
-int Parrot_fetch_arg_nci(PARROT_INTERP, ARGMOD(call_state *st))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-PARROT_EXPORT
-int Parrot_init_arg_indexes_and_sig_pmc(PARROT_INTERP,
- ARGIN(Parrot_Context *ctx),
- ARGIN_NULLOK(opcode_t *indexes),
- ARGIN_NULLOK(PMC *sig_pmc),
- ARGMOD(call_state_item *sti))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(5)
- FUNC_MODIFIES(*sti);
-
-PARROT_EXPORT
-void Parrot_init_arg_nci(PARROT_INTERP,
- ARGOUT(call_state *st),
- ARGIN(const char *sig))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- FUNC_MODIFIES(*st);
-
-PARROT_EXPORT
-int Parrot_init_arg_op(PARROT_INTERP,
- ARGIN(Parrot_Context *ctx),
- ARGIN_NULLOK(opcode_t *pc),
- ARGIN(call_state_item *sti))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(4);
-
-PARROT_EXPORT
-int Parrot_init_arg_sig(PARROT_INTERP,
- ARGIN(Parrot_Context *ctx),
- ARGIN(const char *sig),
- ARGIN_NULLOK(void *ap),
- ARGMOD(call_state_item *sti))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- __attribute__nonnull__(5)
- FUNC_MODIFIES(*sti);
-
-PARROT_EXPORT
-void Parrot_init_ret_nci(PARROT_INTERP,
- ARGOUT(call_state *st),
- ARGIN(const char *sig))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- FUNC_MODIFIES(*st);
-
-PARROT_EXPORT
-void parrot_pass_args(PARROT_INTERP,
- ARGMOD(Parrot_Context *src_ctx),
- ARGMOD(Parrot_Context *dest_ctx),
- ARGMOD_NULLOK(opcode_t *src_indexes),
- ARGMOD_NULLOK(opcode_t *dest_indexes),
- arg_pass_t param_or_result)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- FUNC_MODIFIES(*src_ctx)
- FUNC_MODIFIES(*dest_ctx)
- FUNC_MODIFIES(*src_indexes)
- FUNC_MODIFIES(*dest_indexes);
-
-PARROT_EXPORT
-void Parrot_pcc_invoke_from_sig_object(PARROT_INTERP,
- ARGIN(PMC *sub_obj),
- ARGIN(PMC *sig_obj))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
-
-PARROT_EXPORT
-void Parrot_pcc_invoke_method_from_c_args(PARROT_INTERP,
- ARGIN(PMC* pmc),
- ARGMOD(STRING *method_name),
- ARGIN(const char *signature),
- ...)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4)
- FUNC_MODIFIES(*method_name);
-
-PARROT_EXPORT
-void Parrot_pcc_invoke_sub_from_c_args(PARROT_INTERP,
- ARGIN(PMC *sub_obj),
- ARGIN(const char *sig),
- ...)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
-
-PARROT_EXPORT
-void Parrot_PCCINVOKE(PARROT_INTERP,
- ARGIN(PMC* pmc),
- ARGMOD(STRING *method_name),
- ARGIN(const char *signature),
- ...)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4)
- FUNC_MODIFIES(*method_name);
-
-PARROT_EXPORT
-void Parrot_process_args(PARROT_INTERP,
- ARGMOD(call_state *st),
- arg_pass_t param_or_result)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-PARROT_EXPORT
-int Parrot_store_arg(SHIM_INTERP, ARGIN(const call_state *st))
- __attribute__nonnull__(2);
-
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-opcode_t * parrot_pass_args_fromc(PARROT_INTERP,
- ARGIN(const char *sig),
- ARGMOD(opcode_t *dest),
- ARGIN(Parrot_Context *old_ctxp),
- va_list ap)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4)
- FUNC_MODIFIES(*dest);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-void * set_retval(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
- __attribute__nonnull__(1)
- __attribute__nonnull__(3);
-
-FLOATVAL set_retval_f(PARROT_INTERP,
- int sig_ret,
- ARGIN(Parrot_Context *ctx))
- __attribute__nonnull__(1)
- __attribute__nonnull__(3);
-
-INTVAL set_retval_i(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
- __attribute__nonnull__(1)
- __attribute__nonnull__(3);
-
-PARROT_CAN_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-PMC* set_retval_p(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
- __attribute__nonnull__(1)
- __attribute__nonnull__(3);
-
-PARROT_CAN_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-STRING* set_retval_s(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
- __attribute__nonnull__(1)
- __attribute__nonnull__(3);
-
-#define ASSERT_ARGS_Parrot_convert_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_Parrot_fetch_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_Parrot_fetch_arg_nci __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_Parrot_init_arg_indexes_and_sig_pmc \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ctx) \
- || PARROT_ASSERT_ARG(sti)
-#define ASSERT_ARGS_Parrot_init_arg_nci __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_Parrot_init_arg_op __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ctx) \
- || PARROT_ASSERT_ARG(sti)
-#define ASSERT_ARGS_Parrot_init_arg_sig __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ctx) \
- || PARROT_ASSERT_ARG(sig) \
- || PARROT_ASSERT_ARG(sti)
-#define ASSERT_ARGS_Parrot_init_ret_nci __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_parrot_pass_args __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(src_ctx) \
- || PARROT_ASSERT_ARG(dest_ctx)
-#define ASSERT_ARGS_Parrot_pcc_invoke_from_sig_object \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub_obj) \
- || PARROT_ASSERT_ARG(sig_obj)
-#define ASSERT_ARGS_Parrot_pcc_invoke_method_from_c_args \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pmc) \
- || PARROT_ASSERT_ARG(method_name) \
- || PARROT_ASSERT_ARG(signature)
-#define ASSERT_ARGS_Parrot_pcc_invoke_sub_from_c_args \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub_obj) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_Parrot_PCCINVOKE __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pmc) \
- || PARROT_ASSERT_ARG(method_name) \
- || PARROT_ASSERT_ARG(signature)
-#define ASSERT_ARGS_Parrot_process_args __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_Parrot_store_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_parrot_pass_args_fromc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sig) \
- || PARROT_ASSERT_ARG(dest) \
- || PARROT_ASSERT_ARG(old_ctxp)
-#define ASSERT_ARGS_set_retval __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ctx)
-#define ASSERT_ARGS_set_retval_f __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ctx)
-#define ASSERT_ARGS_set_retval_i __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ctx)
-#define ASSERT_ARGS_set_retval_p __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ctx)
-#define ASSERT_ARGS_set_retval_s __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ctx)
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: src/inter_call.c */
-
-#define ASSERT_SIG_PMC(sig) \
- PARROT_ASSERT(PObj_is_PMC_TEST(sig)); \
- PARROT_ASSERT((sig)->vtable->base_type == enum_class_FixedIntegerArray)
-
-/* XXX Remove interp from this */
-#define ADD_OP_VAR_PART(interp, seg, pc, n) do { \
- if (*(pc) == PARROT_OP_set_args_pc || \
- *(pc) == PARROT_OP_get_results_pc || \
- *(pc) == PARROT_OP_get_params_pc || \
- *(pc) == PARROT_OP_set_returns_pc) { \
- PMC * const sig = (seg)->const_table->constants[(pc)[1]]->u.key; \
- (n) += VTABLE_elements((interp), sig); \
- } \
-} while (0)
-
-
-#endif /* PARROT_INTER_CALL_H_GUARD */
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Modified: trunk/include/parrot/interpreter.h
==============================================================================
--- trunk/include/parrot/interpreter.h Wed Feb 11 20:23:35 2009 (r36594)
+++ trunk/include/parrot/interpreter.h Wed Feb 11 20:42:56 2009 (r36595)
@@ -526,281 +526,6 @@
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: src/inter_create.c */
-/* HEADERIZER BEGIN: src/inter_run.c */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-PARROT_EXPORT
-void free_runloop_jump_point(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-PARROT_EXPORT
-void new_runloop_jump_point(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-void * Parrot_run_meth_fromc(PARROT_INTERP,
- ARGIN(PMC *sub),
- ARGIN_NULLOK(PMC *obj),
- SHIM(STRING *meth))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-void* Parrot_run_meth_fromc_arglist(PARROT_INTERP,
- ARGIN(PMC *sub),
- ARGIN_NULLOK(PMC *obj),
- ARGIN(STRING *meth),
- ARGIN(const char *sig),
- va_list args)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(4)
- __attribute__nonnull__(5);
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-FLOATVAL Parrot_run_meth_fromc_arglist_retf(PARROT_INTERP,
- ARGIN(PMC *sub),
- ARGIN_NULLOK(PMC *obj),
- ARGIN(STRING *meth),
- ARGIN(const char *sig),
- va_list args)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(4)
- __attribute__nonnull__(5);
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-INTVAL Parrot_run_meth_fromc_arglist_reti(PARROT_INTERP,
- ARGIN(PMC *sub),
- ARGIN_NULLOK(PMC *obj),
- ARGIN(STRING *meth),
- ARGIN(const char *sig),
- va_list args)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(4)
- __attribute__nonnull__(5);
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-void* Parrot_run_meth_fromc_args(PARROT_INTERP,
- ARGIN(PMC *sub),
- ARGIN_NULLOK(PMC *obj),
- ARGIN(STRING *meth),
- ARGIN(const char *sig),
- ...)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(4)
- __attribute__nonnull__(5);
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-FLOATVAL Parrot_run_meth_fromc_args_retf(PARROT_INTERP,
- ARGIN(PMC *sub),
- ARGIN_NULLOK(PMC *obj),
- ARGIN(STRING *meth),
- ARGIN(const char *sig),
- ...)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(4)
- __attribute__nonnull__(5);
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-INTVAL Parrot_run_meth_fromc_args_reti(PARROT_INTERP,
- ARGIN(PMC *sub),
- ARGIN_NULLOK(PMC *obj),
- ARGIN(STRING *meth),
- ARGIN(const char *sig),
- ...)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(4)
- __attribute__nonnull__(5);
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CANNOT_RETURN_NULL
-Parrot_Context * Parrot_runops_fromc(PARROT_INTERP, ARGIN(PMC *sub))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-void * Parrot_runops_fromc_arglist(PARROT_INTERP,
- ARGIN(PMC *sub),
- ARGIN(const char *sig),
- va_list args)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-FLOATVAL Parrot_runops_fromc_arglist_retf(PARROT_INTERP,
- ARGIN(PMC *sub),
- ARGIN(const char *sig),
- va_list args)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-INTVAL Parrot_runops_fromc_arglist_reti(PARROT_INTERP,
- ARGIN(PMC *sub),
- ARGIN(const char *sig),
- va_list args)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-PMC * Parrot_runops_fromc_args(PARROT_INTERP,
- ARGIN(PMC *sub),
- ARGIN(const char *sig),
- ...)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-void * Parrot_runops_fromc_args_event(PARROT_INTERP,
- ARGIN(PMC *sub),
- ARGIN(const char *sig),
- ...)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-FLOATVAL Parrot_runops_fromc_args_retf(PARROT_INTERP,
- ARGIN(PMC *sub),
- ARGIN(const char *sig),
- ...)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-INTVAL Parrot_runops_fromc_args_reti(PARROT_INTERP,
- ARGIN(PMC *sub),
- ARGIN(const char *sig),
- ...)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
-
-void destroy_runloop_jump_points(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-void really_destroy_runloop_jump_points(
- ARGIN_NULLOK(Parrot_runloop *jump_point));
-
-void runops(PARROT_INTERP, size_t offs)
- __attribute__nonnull__(1);
-
-#define ASSERT_ARGS_free_runloop_jump_point __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_new_runloop_jump_point __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_Parrot_run_meth_fromc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub)
-#define ASSERT_ARGS_Parrot_run_meth_fromc_arglist __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub) \
- || PARROT_ASSERT_ARG(meth) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_Parrot_run_meth_fromc_arglist_retf \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub) \
- || PARROT_ASSERT_ARG(meth) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_Parrot_run_meth_fromc_arglist_reti \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub) \
- || PARROT_ASSERT_ARG(meth) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_Parrot_run_meth_fromc_args __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub) \
- || PARROT_ASSERT_ARG(meth) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_Parrot_run_meth_fromc_args_retf \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub) \
- || PARROT_ASSERT_ARG(meth) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_Parrot_run_meth_fromc_args_reti \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub) \
- || PARROT_ASSERT_ARG(meth) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_Parrot_runops_fromc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub)
-#define ASSERT_ARGS_Parrot_runops_fromc_arglist __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_Parrot_runops_fromc_arglist_retf \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_Parrot_runops_fromc_arglist_reti \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_Parrot_runops_fromc_args __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_Parrot_runops_fromc_args_event \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_Parrot_runops_fromc_args_retf __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_Parrot_runops_fromc_args_reti __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub) \
- || PARROT_ASSERT_ARG(sig)
-#define ASSERT_ARGS_destroy_runloop_jump_points __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_really_destroy_runloop_jump_points \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
-#define ASSERT_ARGS_runops __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: src/inter_run.c */
-
/* HEADERIZER BEGIN: src/inter_cb.c */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
Modified: trunk/include/parrot/multidispatch.h
==============================================================================
--- trunk/include/parrot/multidispatch.h Wed Feb 11 20:23:35 2009 (r36594)
+++ trunk/include/parrot/multidispatch.h Wed Feb 11 20:42:56 2009 (r36595)
@@ -57,16 +57,6 @@
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_EXPORT
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-PMC* Parrot_build_sig_object_from_varargs(PARROT_INTERP,
- ARGIN_NULLOK(PMC* obj),
- ARGIN(const char *sig),
- va_list args)
- __attribute__nonnull__(1)
- __attribute__nonnull__(3);
-
-PARROT_EXPORT
void Parrot_mmd_add_multi_from_c_args(PARROT_INTERP,
ARGIN(const char *sub_name),
ARGIN(const char *short_sig),
@@ -217,10 +207,6 @@
__attribute__nonnull__(2)
__attribute__nonnull__(3);
-#define ASSERT_ARGS_Parrot_build_sig_object_from_varargs \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sig)
#define ASSERT_ARGS_Parrot_mmd_add_multi_from_c_args \
__attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
Modified: trunk/include/parrot/parrot.h
==============================================================================
--- trunk/include/parrot/parrot.h Wed Feb 11 20:23:35 2009 (r36594)
+++ trunk/include/parrot/parrot.h Wed Feb 11 20:42:56 2009 (r36595)
@@ -302,7 +302,7 @@
#include "parrot/string_funcs.h"
#include "parrot/misc.h"
#include "parrot/sub.h"
-#include "parrot/inter_call.h"
+#include "parrot/call.h"
#include "parrot/key.h"
#include "parrot/exit.h"
#include "parrot/nci.h"
Copied and modified: trunk/src/call/ops.c (from r36591, trunk/src/inter_run.c)
==============================================================================
--- trunk/src/inter_run.c Wed Feb 11 20:04:17 2009 (r36591, copy source)
+++ trunk/src/call/ops.c Wed Feb 11 20:42:56 2009 (r36595)
@@ -2,11 +2,9 @@
Copyright (C) 2001-2008, The Perl Foundation.
$Id$
-=head1 NAME
+=head1 Calling Ops
-src/inter_run.c - Parrot Interpreter - Run Ops and Methods
-
-=head1 DESCRIPTION
+=head1 Description
Various functions that call the run loop.
@@ -22,7 +20,7 @@
#include "parrot/parrot.h"
#include "parrot/oplib/ops.h"
-/* HEADERIZER HFILE: include/parrot/interpreter.h */
+/* HEADERIZER HFILE: include/parrot/call.h */
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
Copied and modified: trunk/src/call/pcc.c (from r36591, trunk/src/inter_call.c)
==============================================================================
--- trunk/src/inter_call.c Wed Feb 11 20:04:17 2009 (r36591, copy source)
+++ trunk/src/call/pcc.c Wed Feb 11 20:42:56 2009 (r36595)
@@ -2,11 +2,9 @@
Copyright (C) 2001-2008, The Perl Foundation.
$Id$
-=head1 NAME
+=head1 Parrot Calling Conventions
-src/inter_call.c - Parrot Interpreter - Argument passing code
-
-=head1 DESCRIPTION
+=head1 Description
Functions in this file handle argument/return value passing to and from
subroutines.
@@ -21,9 +19,9 @@
#include "parrot/parrot.h"
#include "parrot/oplib/ops.h"
-#include "inter_call.str"
+#include "pcc.str"
-/* HEADERIZER HFILE: include/parrot/inter_call.h */
+/* HEADERIZER HFILE: include/parrot/call.h */
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
@@ -348,6 +346,122 @@
(orig).bp = (save).bp;\
(orig).bp_ps = (save).bp_ps;
+/*
+
+=item C<PMC* Parrot_pcc_build_sig_object_from_varargs>
+
+Take a varargs list, and convert it into a CallSignature PMC. The CallSignature
+stores the original short signature string, and an array of integer types to
+pass on to the multiple dispatch search.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+PMC*
+Parrot_pcc_build_sig_object_from_varargs(PARROT_INTERP, ARGIN_NULLOK(PMC* obj),
+ ARGIN(const char *sig), va_list args)
+{
+ ASSERT_ARGS(Parrot_pcc_build_sig_object_from_varargs)
+ PMC *type_tuple = PMCNULL;
+ PMC *returns = PMCNULL;
+ PMC *call_object = pmc_new(interp, enum_class_CallSignature);
+ STRING *string_sig = Parrot_str_new_constant(interp, sig);
+ const INTVAL sig_len = Parrot_str_byte_length(interp, string_sig);
+ INTVAL in_return_sig = 0;
+ INTVAL i;
+
+ if (!sig_len)
+ return call_object;
+
+ VTABLE_set_string_native(interp, call_object, string_sig);
+
+ /* Process the varargs list */
+ for (i = 0; i < sig_len; ++i) {
+ const INTVAL type = Parrot_str_indexed(interp, string_sig, i);
+
+ /* Only create the returns array if it's needed */
+ if (in_return_sig && PMC_IS_NULL(returns)) {
+ returns = pmc_new(interp, enum_class_ResizablePMCArray);
+ VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "results"), returns);
+ }
+
+ if (in_return_sig) {
+ STRING * const signature = CONST_STRING(interp, "signature");
+ /* Returns store the original passed-in pointer, so they can pass
+ * the result back to the caller. */
+ PMC * const val_pointer = pmc_new(interp, enum_class_CPointer);
+ VTABLE_push_pmc(interp, returns, val_pointer);
+
+ switch (type) {
+ case 'I':
+ VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, INTVAL *));
+ VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "I"));
+ break;
+ case 'N':
+ VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, FLOATVAL *));
+ VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "N"));
+ break;
+ case 'S':
+ VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, STRING **));
+ VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "S"));
+ break;
+ case 'P':
+ VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, PMC **));
+ VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "P"));
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "Multiple Dispatch: invalid argument type %c!", type);
+ }
+ }
+ else {
+ /* Regular arguments just set the value */
+ switch (type) {
+ case 'I':
+ VTABLE_push_integer(interp, call_object, va_arg(args, INTVAL));
+ break;
+ case 'N':
+ VTABLE_push_float(interp, call_object, va_arg(args, FLOATVAL));
+ break;
+ case 'S':
+ VTABLE_push_string(interp, call_object, va_arg(args, STRING *));
+ break;
+ case 'P':
+ {
+ PMC * const pmc_arg = va_arg(args, PMC *);
+ VTABLE_push_pmc(interp, call_object, pmc_arg);
+ break;
+ }
+ case '-':
+ i++; /* skip '>' */
+ in_return_sig = 1;
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "Multiple Dispatch: invalid argument type %c!", type);
+ }
+ }
+ }
+
+ /* Check if we have an invocant, and add it to the front of the arguments */
+ if (!PMC_IS_NULL(obj)) {
+ string_sig = Parrot_str_concat(interp, CONST_STRING(interp, "Pi"), string_sig, 0);
+ VTABLE_set_string_native(interp, call_object, string_sig);
+ VTABLE_unshift_pmc(interp, call_object, obj);
+ }
+
+ /* Build a type_tuple for multiple dispatch */
+ type_tuple = Parrot_mmd_build_type_tuple_from_sig_obj(interp, call_object);
+ VTABLE_set_pmc(interp, call_object, type_tuple);
+
+ return call_object;
+}
/*
@@ -2507,7 +2621,7 @@
PMC *sig_obj;
va_list args;
va_start(args, sig);
- sig_obj = Parrot_build_sig_object_from_varargs(interp, PMCNULL, sig, args);
+ sig_obj = Parrot_pcc_build_sig_object_from_varargs(interp, PMCNULL, sig, args);
va_end(args);
Parrot_pcc_invoke_from_sig_object(interp, sub_obj, sig_obj);
@@ -2767,7 +2881,7 @@
PMC *sub_obj;
va_list args;
va_start(args, signature);
- sig_obj = Parrot_build_sig_object_from_varargs(interp, pmc, signature, args);
+ sig_obj = Parrot_pcc_build_sig_object_from_varargs(interp, pmc, signature, args);
va_end(args);
/* Find the subroutine object as a named method on pmc */
Deleted: trunk/src/inter_call.c
==============================================================================
--- trunk/src/inter_call.c Wed Feb 11 20:42:56 2009 (r36594)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,2913 +0,0 @@
-/*
-Copyright (C) 2001-2008, The Perl Foundation.
-$Id$
-
-=head1 NAME
-
-src/inter_call.c - Parrot Interpreter - Argument passing code
-
-=head1 DESCRIPTION
-
-Functions in this file handle argument/return value passing to and from
-subroutines.
-
-=head2 Functions
-
-=over 4
-
-=cut
-
-*/
-
-#include "parrot/parrot.h"
-#include "parrot/oplib/ops.h"
-#include "inter_call.str"
-
-/* HEADERIZER HFILE: include/parrot/inter_call.h */
-
-/* HEADERIZER BEGIN: static */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-static void check_for_opt_flag(PARROT_INTERP,
- ARGMOD(call_state *st),
- int has_arg)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-static void check_named(PARROT_INTERP, ARGMOD(call_state *st))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-static void clone_key_arg(PARROT_INTERP, ARGMOD(call_state *st))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-static void commit_last_arg(PARROT_INTERP,
- int index,
- int cur,
- ARGMOD(opcode_t *n_regs_used),
- int seen_arrow,
- ARGIN(PMC * const *sigs),
- ARGMOD(opcode_t **indexes),
- ARGMOD(Parrot_Context *ctx),
- ARGIN_NULLOK(PMC *pmc),
- ARGIN(va_list *list))
- __attribute__nonnull__(1)
- __attribute__nonnull__(4)
- __attribute__nonnull__(6)
- __attribute__nonnull__(7)
- __attribute__nonnull__(8)
- __attribute__nonnull__(10)
- FUNC_MODIFIES(*n_regs_used)
- FUNC_MODIFIES(*indexes)
- FUNC_MODIFIES(*ctx);
-
-static void commit_last_arg_sig_object(PARROT_INTERP,
- int index,
- int cur,
- ARGMOD(opcode_t *n_regs_used),
- int seen_arrow,
- ARGIN(PMC * const *sigs),
- ARGMOD(opcode_t **indexes),
- ARGMOD(Parrot_Context *ctx),
- ARGIN(PMC *sig_obj))
- __attribute__nonnull__(1)
- __attribute__nonnull__(4)
- __attribute__nonnull__(6)
- __attribute__nonnull__(7)
- __attribute__nonnull__(8)
- __attribute__nonnull__(9)
- FUNC_MODIFIES(*n_regs_used)
- FUNC_MODIFIES(*indexes)
- FUNC_MODIFIES(*ctx);
-
-static void convert_arg_from_int(PARROT_INTERP, ARGMOD(call_state *st))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-static void convert_arg_from_num(PARROT_INTERP, ARGMOD(call_state *st))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-static void convert_arg_from_pmc(PARROT_INTERP, ARGMOD(call_state *st))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-static void convert_arg_from_str(PARROT_INTERP, ARGMOD(call_state *st))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-PARROT_CANNOT_RETURN_NULL
-static Parrot_Context * count_signature_elements(PARROT_INTERP,
- ARGIN(const char *signature),
- ARGMOD(PMC *args_sig),
- ARGMOD(PMC *results_sig),
- int flag)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4)
- FUNC_MODIFIES(*args_sig)
- FUNC_MODIFIES(*results_sig);
-
-static int fetch_arg_op(PARROT_INTERP, ARGMOD(call_state *st))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-static int fetch_arg_sig(PARROT_INTERP, ARGMOD(call_state *st))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-static void init_call_stats(ARGMOD(call_state *st))
- __attribute__nonnull__(1)
- FUNC_MODIFIES(*st);
-
-static void init_first_dest_named(PARROT_INTERP, ARGMOD(call_state *st))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-static int locate_named_named(PARROT_INTERP, ARGMOD(call_state *st))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-static void next_arg_sig(PARROT_INTERP, ARGMOD(call_state_item *sti))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*sti);
-
-static void null_val(int sig, ARGMOD(call_state *st))
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*st);
-
-PARROT_CAN_RETURN_NULL
-static const char * set_context_sig_params(PARROT_INTERP,
- ARGIN(const char *signature),
- ARGMOD(INTVAL *n_regs_used),
- ARGMOD(PMC **sigs),
- ARGMOD(opcode_t **indexes),
- ARGMOD(Parrot_Context *ctx),
- ARGMOD(PMC *sig_obj))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4)
- __attribute__nonnull__(5)
- __attribute__nonnull__(6)
- __attribute__nonnull__(7)
- FUNC_MODIFIES(*n_regs_used)
- FUNC_MODIFIES(*sigs)
- FUNC_MODIFIES(*indexes)
- FUNC_MODIFIES(*ctx)
- FUNC_MODIFIES(*sig_obj);
-
-static void set_context_sig_returns(PARROT_INTERP,
- ARGMOD(Parrot_Context *ctx),
- ARGMOD(opcode_t **indexes),
- ARGIN_NULLOK(const char *ret_x),
- ARGMOD(PMC *result_list))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- __attribute__nonnull__(5)
- FUNC_MODIFIES(*ctx)
- FUNC_MODIFIES(*indexes)
- FUNC_MODIFIES(*result_list);
-
-static void set_context_sig_returns_varargs(PARROT_INTERP,
- ARGMOD(Parrot_Context *ctx),
- ARGMOD(opcode_t **indexes),
- ARGIN(const char *ret_x),
- ARGMOD(va_list returns))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4)
- __attribute__nonnull__(5)
- FUNC_MODIFIES(*ctx)
- FUNC_MODIFIES(*indexes)
- FUNC_MODIFIES(returns);
-
-static int set_retval_util(PARROT_INTERP,
- ARGIN(const char *sig),
- ARGIN(Parrot_Context *ctx),
- ARGMOD(call_state *st))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4)
- FUNC_MODIFIES(*st);
-
-static void start_flatten(PARROT_INTERP,
- ARGMOD(call_state *st),
- ARGIN(PMC *p_arg))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- FUNC_MODIFIES(*st);
-
-static void store_arg(ARGIN(const call_state *st), INTVAL idx)
- __attribute__nonnull__(1);
-
-static void too_few(PARROT_INTERP,
- ARGIN(const call_state *st),
- ARGIN(const char *action))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
-
-static void too_many(PARROT_INTERP,
- ARGIN(const call_state *st),
- ARGIN(const char *action))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
-
-#define ASSERT_ARGS_check_for_opt_flag __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_check_named __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_clone_key_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_commit_last_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(n_regs_used) \
- || PARROT_ASSERT_ARG(sigs) \
- || PARROT_ASSERT_ARG(indexes) \
- || PARROT_ASSERT_ARG(ctx) \
- || PARROT_ASSERT_ARG(list)
-#define ASSERT_ARGS_commit_last_arg_sig_object __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(n_regs_used) \
- || PARROT_ASSERT_ARG(sigs) \
- || PARROT_ASSERT_ARG(indexes) \
- || PARROT_ASSERT_ARG(ctx) \
- || PARROT_ASSERT_ARG(sig_obj)
-#define ASSERT_ARGS_convert_arg_from_int __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_convert_arg_from_num __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_convert_arg_from_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_convert_arg_from_str __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_count_signature_elements __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(signature) \
- || PARROT_ASSERT_ARG(args_sig) \
- || PARROT_ASSERT_ARG(results_sig)
-#define ASSERT_ARGS_fetch_arg_op __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_fetch_arg_sig __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_init_call_stats __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_init_first_dest_named __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_locate_named_named __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_next_arg_sig __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sti)
-#define ASSERT_ARGS_null_val __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_set_context_sig_params __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(signature) \
- || PARROT_ASSERT_ARG(n_regs_used) \
- || PARROT_ASSERT_ARG(sigs) \
- || PARROT_ASSERT_ARG(indexes) \
- || PARROT_ASSERT_ARG(ctx) \
- || PARROT_ASSERT_ARG(sig_obj)
-#define ASSERT_ARGS_set_context_sig_returns __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ctx) \
- || PARROT_ASSERT_ARG(indexes) \
- || PARROT_ASSERT_ARG(result_list)
-#define ASSERT_ARGS_set_context_sig_returns_varargs \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ctx) \
- || PARROT_ASSERT_ARG(indexes) \
- || PARROT_ASSERT_ARG(ret_x) \
- || PARROT_ASSERT_ARG(returns)
-#define ASSERT_ARGS_set_retval_util __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sig) \
- || PARROT_ASSERT_ARG(ctx) \
- || PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_start_flatten __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st) \
- || PARROT_ASSERT_ARG(p_arg)
-#define ASSERT_ARGS_store_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_too_few __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st) \
- || PARROT_ASSERT_ARG(action)
-#define ASSERT_ARGS_too_many __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(st) \
- || PARROT_ASSERT_ARG(action)
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: static */
-
-
-/* Make sure we don't conflict with any other MAX() macros defined elsewhere */
-#define PARROT_MAX(a, b) (((a)) > (b) ? (a) : (b))
-
-#define SAVE_OFF_REGS(orig, next, save) \
- (save).bp = (orig).bp;\
- (save).bp_ps = (orig).bp_ps;\
- (orig).bp = (next).bp;\
- (orig).bp_ps = (next).bp_ps;
-
-#define RESTORE_REGS(orig, save) \
- (orig).bp = (save).bp;\
- (orig).bp_ps = (save).bp_ps;
-
-
-/*
-
-=item C<void Parrot_init_arg_nci>
-
-Initializes the argument passing state C<call_state> for the given NCI
-signature.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_init_arg_nci(PARROT_INTERP, ARGOUT(call_state *st),
- ARGIN(const char *sig))
-{
- ASSERT_ARGS(Parrot_init_arg_nci)
- init_call_stats(st);
-
- if (PMC_IS_NULL(interp->args_signature))
- Parrot_init_arg_op(interp, CONTEXT(interp), interp->current_args,
- &st->src);
- else
- Parrot_init_arg_indexes_and_sig_pmc(interp, CONTEXT(interp),
- interp->current_args, interp->args_signature, &st->src);
-
- Parrot_init_arg_sig(interp, CONTEXT(interp), sig, NULL, &st->dest);
-}
-
-
-/*
-
-=item C<void Parrot_init_ret_nci>
-
-Initializes the return value, passing state C<call_state> for the given NCI
-signature.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_init_ret_nci(PARROT_INTERP, ARGOUT(call_state *st), ARGIN(const char *sig))
-{
- ASSERT_ARGS(Parrot_init_ret_nci)
- Parrot_Context *ctx = CONTEXT(interp);
- PMC * const current_cont = ctx->current_cont;
-
- /* if this NCI call was a taicall, return results to caller's get_results
- * this also means that we pass the caller's register base pointer */
- if (SUB_FLAG_TAILCALL_ISSET(current_cont))
- ctx = PMC_cont(current_cont)->to_ctx;
-
- /* TODO simplify all */
- Parrot_init_arg_sig(interp, CONTEXT(interp), sig, NULL, &st->src);
-
- /* Non-constant signatures are stored in ctx->results_signature instead of
- * in the constants table. */
- if (ctx->results_signature)
- Parrot_init_arg_indexes_and_sig_pmc(interp, ctx,
- ctx->current_results, ctx->results_signature, &st->dest);
- else
- Parrot_init_arg_op(interp, ctx, ctx->current_results, &st->dest);
-
-}
-
-
-/*
-
-=item C<int Parrot_init_arg_indexes_and_sig_pmc>
-
-Initializes argument transfer with given context registers, register indexes,
-and a signature PMC.
-
-All C<Parrot_init_arg*> functions can be used for either source or destination,
-by passing either C<&st.src> or C<&st.dest> of a C<call_state> structure.
-
-These functions return 0 if no arguments are present, or 1 on success.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-int
-Parrot_init_arg_indexes_and_sig_pmc(PARROT_INTERP, ARGIN(Parrot_Context *ctx),
- ARGIN_NULLOK(opcode_t *indexes), ARGIN_NULLOK(PMC *sig_pmc),
- ARGMOD(call_state_item *sti))
-{
- ASSERT_ARGS(Parrot_init_arg_indexes_and_sig_pmc)
- if (!sig_pmc && indexes) {
- ++indexes;
- sig_pmc = ctx->constants[*indexes]->u.key;
- ASSERT_SIG_PMC(sig_pmc);
- ++indexes;
- }
-
- sti->used = 1;
- sti->i = 0;
- sti->n = 0;
- sti->mode = CALL_STATE_OP;
- sti->ctx = ctx;
- sti->sig = 0;
- sti->slurp = NULL;
-
- if (indexes) {
- ASSERT_SIG_PMC(sig_pmc);
- sti->u.op.signature = sig_pmc;
- sti->u.op.pc = indexes;
- sti->n = VTABLE_elements(interp, sig_pmc);
-
- /* initialize sti->sig */
- if (sti->n)
- next_arg_sig(interp, sti);
- }
-
- return sti->n > 0;
-}
-
-
-/*
-
-=item C<int Parrot_init_arg_op>
-
-Initializes argument transfer with given context registers and opcode location
-of a C<get_*> or C<set_*> argument opcode.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-int
-Parrot_init_arg_op(PARROT_INTERP, ARGIN(Parrot_Context *ctx),
- ARGIN_NULLOK(opcode_t *pc), ARGIN(call_state_item *sti))
-{
- ASSERT_ARGS(Parrot_init_arg_op)
- PMC *sig_pmc = PMCNULL;
-
- if (pc) {
- ++pc;
- sig_pmc = ctx->constants[*pc]->u.key;
- ASSERT_SIG_PMC(sig_pmc);
- ++pc;
- }
-
- return Parrot_init_arg_indexes_and_sig_pmc(interp, ctx, pc, sig_pmc, sti);
-}
-
-
-/*
-
-=item C<int Parrot_init_arg_sig>
-
-Initializes argument transfer with given code segment (holding the
-const_table), registers, function signature, and arguments.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-int
-Parrot_init_arg_sig(PARROT_INTERP, ARGIN(Parrot_Context *ctx),
- ARGIN(const char *sig), ARGIN_NULLOK(void *ap),
- ARGMOD(call_state_item *sti))
-{
- ASSERT_ARGS(Parrot_init_arg_sig)
- sti->used = 1;
- sti->i = 0;
- sti->n = 0;
- sti->mode = CALL_STATE_SIG;
- sti->ctx = ctx;
- sti->sig = 0;
-
- if (*sig) {
- sti->u.sig.sig = sig;
- sti->u.sig.ap = ap;
- sti->n = strlen(sig);
-
- /* initialize st->sig */
- if (sti->n)
- next_arg_sig(interp, sti);
- }
-
- return sti->n > 0;
-}
-
-
-/*
-
-=item C<static void start_flatten>
-
-Marks the source state as flattening with the passed PMC being flattened and
-fetches the first arg from the flattened set.
-
-=cut
-
-*/
-
-static void
-start_flatten(PARROT_INTERP, ARGMOD(call_state *st), ARGIN(PMC *p_arg))
-{
- ASSERT_ARGS(start_flatten)
- if (PARROT_ARG_NAME_ISSET(st->src.sig)) {
-
- /* src ought to be an hash */
- if (!VTABLE_does(interp, p_arg, CONST_STRING(interp, "hash")))
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "argument doesn't hash");
-
- /* create key needed to iterate the hash */
- st->key = pmc_new(interp, enum_class_Key);
- PMC_int_val(st->key) = 0;
- PMC_data(st->key) = (void *)INITBucketIndex;
- }
- else {
- /* src ought to be an array */
- if (!VTABLE_does(interp, p_arg, CONST_STRING(interp, "array")))
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "argument doesn't array");
- }
-
- st->src.mode |= CALL_STATE_FLATTEN;
- st->src.slurp = p_arg;
- st->src.slurp_i = 0;
- st->src.slurp_n = VTABLE_elements(interp, p_arg);
-
- /* the -1 is because the :flat PMC itself doesn't count. */
- st->n_actual_args += st->src.slurp_n - 1;
-}
-
-
-/*
-
-=item C<static void next_arg_sig>
-
-Moves the call state to the next argument in the signature, calculating which
-type of argument/parameter to get next. The index gets increased elsewhere.
-
-=cut
-
-*/
-
-static void
-next_arg_sig(PARROT_INTERP, ARGMOD(call_state_item *sti))
-{
- ASSERT_ARGS(next_arg_sig)
- switch (sti->mode & CALL_S_D_MASK) {
- case CALL_STATE_OP:
- sti->sig = VTABLE_get_integer_keyed_int(interp,
- sti->u.op.signature, sti->i);
- break;
- case CALL_STATE_SIG:
- switch (sti->u.sig.sig[sti->i]) {
- case 'I':
- sti->sig = PARROT_ARG_INTVAL; break;
- case 'N':
- sti->sig = PARROT_ARG_FLOATVAL; break;
- case 'S':
- sti->sig = PARROT_ARG_STRING; break;
- case 'O':
- case 'P':
- sti->sig = PARROT_ARG_PMC; break;
- case '@':
- sti->sig = PARROT_ARG_PMC | PARROT_ARG_SLURPY_ARRAY; break;
- case 'F':
- sti->sig = PARROT_ARG_PMC | PARROT_ARG_FLATTEN; break;
- default:
- break;
- }
- break;
- default:
- break;
- }
-}
-
-
-/*
-
-=item C<static int fetch_arg_sig>
-
-Fetches the next argument from the signature in the given call state.
-
-=cut
-
-*/
-
-static int
-fetch_arg_sig(PARROT_INTERP, ARGMOD(call_state *st))
-{
- ASSERT_ARGS(fetch_arg_sig)
- va_list * const ap = (va_list *)(st->src.u.sig.ap);
-
- switch (st->src.sig & PARROT_ARG_TYPE_MASK) {
- case PARROT_ARG_INTVAL:
- UVal_int(st->val) = va_arg(*ap, INTVAL);
- break;
- case PARROT_ARG_STRING:
- UVal_str(st->val) = va_arg(*ap, STRING *);
- break;
- case PARROT_ARG_FLOATVAL:
- UVal_num(st->val) = va_arg(*ap, FLOATVAL);
- break;
- case PARROT_ARG_PMC:
- if (st->src.u.sig.sig[st->src.i] == 'O')
- UVal_pmc(st->val) = CONTEXT(interp)->current_object;
- else {
- UVal_pmc(st->val) = va_arg(*ap, PMC *);
- }
-
- if (st->src.sig & PARROT_ARG_FLATTEN) {
- int retval;
- start_flatten(interp, st, UVal_pmc(st->val));
-
- /* if the :flat arg is empty, just go to the next arg */
- if (!st->src.slurp_n) {
- st->src.mode &= ~CALL_STATE_FLATTEN;
- st->src.i++;
- }
-
- st->src.used = 1;
- retval = Parrot_fetch_arg(interp, st);
-
- return retval;
- }
- break;
- default:
- break;
- }
-
- st->src.i++;
- return 1;
-}
-
-
-/*
-
-=item C<static int fetch_arg_op>
-
-Fetches an argument from the appropriate context.
-
-=cut
-
-*/
-
-static int
-fetch_arg_op(PARROT_INTERP, ARGMOD(call_state *st))
-{
- ASSERT_ARGS(fetch_arg_op)
- const int constant = PARROT_ARG_CONSTANT_ISSET(st->src.sig);
- const INTVAL idx = st->src.u.op.pc[st->src.i];
-
- switch (PARROT_ARG_TYPE_MASK_MASK(st->src.sig)) {
- case PARROT_ARG_INTVAL:
- UVal_int(st->val) = constant ? idx : CTX_REG_INT(st->src.ctx, idx);
- break;
- case PARROT_ARG_STRING:
- {
- /* ensure that callees don't modify constant caller strings */
- if (constant)
- UVal_str(st->val) = Parrot_str_new_COW(interp,
- st->src.ctx->constants[idx]->u.string);
- else
- UVal_str(st->val) = CTX_REG_STR(st->src.ctx, idx);
-
- break;
- }
- case PARROT_ARG_FLOATVAL:
- UVal_num(st->val) = constant ? st->src.ctx->constants[idx]->u.number
- : CTX_REG_NUM(st->src.ctx, idx);
- break;
- case PARROT_ARG_PMC:
- UVal_pmc(st->val) = constant ? st->src.ctx->constants[idx]->u.key
- : CTX_REG_PMC(st->src.ctx, idx);
-
- if (st->src.sig & PARROT_ARG_FLATTEN) {
- int retval;
- start_flatten(interp, st, UVal_pmc(st->val));
-
- /* if the :flat arg is empty, just go to the next arg */
- if (!st->src.slurp_n) {
- st->src.mode &= ~CALL_STATE_FLATTEN;
- st->src.i++;
- }
-
- st->src.used = 1;
- retval = Parrot_fetch_arg(interp, st);
-
- return retval;
- }
- break;
- default:
- break;
- }
-
- st->src.i++;
- return 1;
-}
-
-
-/*
-
-=item C<int Parrot_fetch_arg>
-
-Fetches an argument from the current call state object. Retrieves the
-next argument in the parameter list, or the next argument in a flattened
-array, if given. If the parameter is a named object, fetches both the
-name and the value.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-int
-Parrot_fetch_arg(PARROT_INTERP, ARGMOD(call_state *st))
-{
- ASSERT_ARGS(Parrot_fetch_arg)
- if (!st->src.used)
- return 1;
-
- if (st->src.i >= st->src.n)
- return 0;
-
- st->src.used = 0;
-
- next_arg_sig(interp, &st->src);
-
- /* check if we're supposed to continue a :flat argument */
- if (st->src.mode & CALL_STATE_FLATTEN) {
- PARROT_ASSERT(st->src.slurp_i < st->src.slurp_n);
- if (!PMC_IS_NULL(st->key)) {
- st->src.slurp_i++;
- st->name = (STRING *)parrot_hash_get_idx(interp,
- (Hash *)PMC_struct_val(st->src.slurp), st->key);
- PARROT_ASSERT(st->name);
- UVal_pmc(st->val) = VTABLE_get_pmc_keyed_str(interp,
- st->src.slurp, st->name);
- }
- else {
- UVal_pmc(st->val) = VTABLE_get_pmc_keyed_int(interp,
- st->src.slurp, st->src.slurp_i++);
- }
-
- st->src.sig = PARROT_ARG_PMC;
-
- /* done with flattening */
- if (st->src.slurp_i == st->src.slurp_n) {
- st->src.mode &= ~CALL_STATE_FLATTEN;
-
- st->key = PMCNULL;
- st->src.i++;
- }
-
- return 1;
- }
-
- /* If we're at a named arg, store the name and then get the next arg, which
- * is the actual value of the named arg. */
- if ((st->src.sig & PARROT_ARG_NAME)
- && !(st->src.sig & PARROT_ARG_FLATTEN)) {
- fetch_arg_op(interp, st);
- st->name = UVal_str(st->val);
- next_arg_sig(interp, &st->src);
- }
-
- switch (st->src.mode & CALL_S_D_MASK) {
- case CALL_STATE_OP:
- return fetch_arg_op(interp, st);
- case CALL_STATE_SIG:
- return fetch_arg_sig(interp, st);
- default:
- Parrot_ex_throw_from_c_args(interp, NULL, 1, "invalid call state mode");
- }
-}
-
-
-/*
-
-=item C<int Parrot_fetch_arg_nci>
-
-Fetches the next argument from the call state and converts it to the proper
-data type for the call signature. If the next argument is a slurpy array,
-all the remaining arguments are slurped together into a ResizablePMCArray
-PMC which is then set as the PMC value of the call_state object.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-int
-Parrot_fetch_arg_nci(PARROT_INTERP, ARGMOD(call_state *st))
-{
- ASSERT_ARGS(Parrot_fetch_arg_nci)
- next_arg_sig(interp, &st->dest);
-
- if (st->dest.sig & PARROT_ARG_SLURPY_ARRAY) {
- PMC *slurped = pmc_new(interp,
- Parrot_get_ctx_HLL_type(interp, enum_class_ResizablePMCArray));
-
- PARROT_ASSERT((st->dest.sig & PARROT_ARG_TYPE_MASK) == PARROT_ARG_PMC);
-
- while (Parrot_fetch_arg(interp, st)) {
- st->src.used = 1;
- Parrot_convert_arg(interp, st);
- VTABLE_push_pmc(interp, slurped, UVal_pmc(st->val));
- }
-
- UVal_pmc(st->val) = slurped;
- }
- else {
- Parrot_fetch_arg(interp, st);
- st->src.used = 1;
- Parrot_convert_arg(interp, st);
- }
-
- st->dest.i++;
- return 1;
-}
-
-/*
-
-=item C<static void convert_arg_from_int>
-
-Autoboxes an int into the expected container type.
-
-=cut
-
-*/
-
-static void
-convert_arg_from_int(PARROT_INTERP, ARGMOD(call_state *st))
-{
- ASSERT_ARGS(convert_arg_from_int)
- switch (st->dest.sig & PARROT_ARG_TYPE_MASK) {
- case PARROT_ARG_FLOATVAL:
- UVal_num(st->val) = (FLOATVAL)UVal_int(st->val);
- break;
- case PARROT_ARG_STRING:
- UVal_str(st->val) = Parrot_str_from_int(interp, UVal_int(st->val));
- break;
- case PARROT_ARG_PMC:
- {
- PMC * const d = pmc_new(interp,
- Parrot_get_ctx_HLL_type(interp, enum_class_Integer));
-
- VTABLE_set_integer_native(interp, d, UVal_int(st->val));
- UVal_pmc(st->val) = d;
- }
- break;
- default:
- break;
- }
-}
-
-/*
-
-=item C<static void convert_arg_from_num>
-
-Autoboxes a num into the expected container type.
-
-=cut
-
-*/
-
-static void
-convert_arg_from_num(PARROT_INTERP, ARGMOD(call_state *st))
-{
- ASSERT_ARGS(convert_arg_from_num)
- switch (st->dest.sig & PARROT_ARG_TYPE_MASK) {
- case PARROT_ARG_INTVAL:
- UVal_int(st->val) = (INTVAL)UVal_num(st->val);
- break;
- case PARROT_ARG_STRING:
- UVal_str(st->val) = Parrot_str_from_num(interp, UVal_num(st->val));
- break;
- case PARROT_ARG_PMC:
- {
- PMC * const d = pmc_new(interp,
- Parrot_get_ctx_HLL_type(interp, enum_class_Float));
-
- VTABLE_set_number_native(interp, d, UVal_num(st->val));
- UVal_pmc(st->val) = d;
- }
- break;
- default:
- break;
- }
-}
-
-
-/*
-
-=item C<static void convert_arg_from_str>
-
-Autoboxes a string primitive to the expected container type.
-
-=cut
-
-*/
-
-static void
-convert_arg_from_str(PARROT_INTERP, ARGMOD(call_state *st))
-{
- ASSERT_ARGS(convert_arg_from_str)
- switch (st->dest.sig & PARROT_ARG_TYPE_MASK) {
- case PARROT_ARG_INTVAL:
- UVal_int(st->val) = Parrot_str_to_int(interp, UVal_str(st->val));
- break;
- case PARROT_ARG_FLOATVAL:
- UVal_num(st->val) = Parrot_str_to_num(interp, UVal_str(st->val));
- break;
- case PARROT_ARG_PMC:
- {
- PMC * const d = pmc_new(interp,
- Parrot_get_ctx_HLL_type(interp, enum_class_String));
-
- VTABLE_set_string_native(interp, d, UVal_str(st->val));
- UVal_pmc(st->val) = d;
- }
- break;
- default:
- break;
- }
-}
-
-/*
-
-=item C<static void convert_arg_from_pmc>
-
-Unboxes a PMC to the expected primitive type.
-
-=cut
-
-*/
-
-static void
-convert_arg_from_pmc(PARROT_INTERP, ARGMOD(call_state *st))
-{
- ASSERT_ARGS(convert_arg_from_pmc)
- switch (st->dest.sig & PARROT_ARG_TYPE_MASK) {
- case PARROT_ARG_INTVAL:
- UVal_int(st->val) = VTABLE_get_integer(interp, UVal_pmc(st->val));
- break;
- case PARROT_ARG_FLOATVAL:
- UVal_num(st->val) = VTABLE_get_number(interp, UVal_pmc(st->val));
- break;
- case PARROT_ARG_STRING:
- UVal_str(st->val) = VTABLE_get_string(interp, UVal_pmc(st->val));
- break;
- default:
- break;
- }
-}
-
-
-/*
-
-=item C<static void check_for_opt_flag>
-
-Processes the next argument, if it has the optional flag set.
-Otherwise moves on.
-
-=cut
-
-*/
-
-static void
-check_for_opt_flag(PARROT_INTERP, ARGMOD(call_state *st), int has_arg)
-{
- ASSERT_ARGS(check_for_opt_flag)
- INTVAL idx;
- call_state_item * const dest = &st->dest;
-
- ++st->optionals;
-
- /* look at the next arg */
- dest->i++;
- if (dest->i >= dest->n)
- return;
-
- next_arg_sig(interp, dest);
-
- /* if this isn't an :opt_flag argument, we need to reset things
- * and go to the next argument */
- if (!(st->dest.sig & PARROT_ARG_OPT_FLAG)) {
- dest->i--;
- return;
- }
-
- /* we're at an :opt_flag argument, so actually store something */
- idx = st->dest.u.op.pc[st->dest.i];
-
- --st->params;
- PARROT_ASSERT(idx >= 0);
- CTX_REG_INT(st->dest.ctx, idx) = has_arg;
-}
-
-
-/*
-
-=item C<static void clone_key_arg>
-
-Replaces any src registers by their values (done inside clone). This needs a
-test for tailcalls too, but I think there is no syntax to pass a key to a
-tailcalled function or method.
-
-=cut
-
-*/
-
-static void
-clone_key_arg(PARROT_INTERP, ARGMOD(call_state *st))
-{
- ASSERT_ARGS(clone_key_arg)
- PMC *key = UVal_pmc(st->val);
-
- if (!key)
- return;
-
- if (key->vtable->base_type != enum_class_Key)
- return;
-
- for (; key; key=key_next(interp, key)) {
- /* register keys have to be cloned */
- if (PObj_get_FLAGS(key) & KEY_register_FLAG) {
- Parrot_Context temp_ctx;
-
- /* clone sets key values according to refered register items */
- SAVE_OFF_REGS(interp->ctx, (*(st->src.ctx)), temp_ctx)
- UVal_pmc(st->val) = VTABLE_clone(interp, key);
- RESTORE_REGS(interp->ctx, temp_ctx)
- return;
- }
- }
-}
-
-
-/*
-
-=item C<static void init_first_dest_named>
-
-Initializes dest calling state for the first named arg.
-
-=cut
-
-*/
-
-static void
-init_first_dest_named(PARROT_INTERP, ARGMOD(call_state *st))
-{
- ASSERT_ARGS(init_first_dest_named)
- int i, n_named;
-
- if (st->dest.mode & CALL_STATE_SIG)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "Can't call C function with named arguments");
-
- st->first_named = st->dest.i;
- n_named = 0;
-
- /* 1) if we were slurpying positional args, we are done, turn it off
- * 2) set destination named args bit */
- st->dest.slurp = NULL;
-
- /* 1) count named args, make sure there is less than 32/64
- * 2) create slurpy hash if needed */
- for (i = st->dest.i; i < st->dest.n; ++i) {
- const INTVAL sig = VTABLE_get_integer_keyed_int(interp,
- st->dest.u.op.signature, i);
-
- /* skip the arg name, only count the actual args of the named args */
- if (!(sig & PARROT_ARG_NAME))
- continue;
-
- /* slurpy named args, create slurpy hash */
- else if (sig & PARROT_ARG_SLURPY_ARRAY) {
- int idx;
-
- /* Create PMC for slurpy mode and register it; we must do this
- * otherwise it may get collected. */
- st->dest.slurp = pmc_new(interp,
- Parrot_get_ctx_HLL_type(interp, enum_class_Hash));
-
- /* pass the slurpy hash */
- idx = st->dest.u.op.pc[i];
- CTX_REG_PMC(st->dest.ctx, idx) = st->dest.slurp;
- }
- /* must be the actual arg of a named arg, count it */
- else
- n_named++;
- }
-
- /* only 32/64 named args allowed;
- * uses UINTVAL as a bitfield to detect duplicates */
- if (n_named >= (int)(sizeof (UINTVAL) * 8))
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "Too many named arguments");
-
- st->named_done = 0;
-}
-
-
-/*
-
-=item C<static int locate_named_named>
-
-Locates a destination argument name, returning 0 if not found.
-
-=cut
-
-*/
-
-static int
-locate_named_named(PARROT_INTERP, ARGMOD(call_state *st))
-{
- ASSERT_ARGS(locate_named_named)
- int i;
- int n_named = -1;
-
- for (i = st->first_named; i < st->dest.n; ++i) {
- int idx;
- STRING *param;
-
- st->dest.sig = VTABLE_get_integer_keyed_int(interp,
- st->dest.u.op.signature, i);
- if (!(st->dest.sig & PARROT_ARG_NAME))
- continue;
-
- if (st->dest.sig & PARROT_ARG_SLURPY_ARRAY)
- return 1;
-
- n_named++;
- idx = st->dest.u.op.pc[i];
- param = PARROT_ARG_CONSTANT_ISSET(st->dest.sig)
- ? st->dest.ctx->constants[idx]->u.string
- : CTX_REG_STR(st->dest.ctx, idx);
-
- if (st->name == param || Parrot_str_not_equal(interp, st->name, param) == 0) {
- ++i;
- st->dest.sig = VTABLE_get_integer_keyed_int(interp,
- st->dest.u.op.signature, i);
- st->dest.i = i;
-
- /* if bit is set we have a duplicate */
- if (st->named_done & (1 << n_named))
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "duplicate named argument - '%Ss' not expected", param);
-
- st->named_done |= 1 << n_named;
- return 1;
- }
- }
-
- return 0;
-}
-
-
-/*
-
-=item C<static void store_arg>
-
-Stores the next argument in the destination register appropriately.
-
-=cut
-
-*/
-
-static void
-store_arg(ARGIN(const call_state *st), INTVAL idx)
-{
- ASSERT_ARGS(store_arg)
- switch (st->dest.sig & PARROT_ARG_TYPE_MASK) {
- case PARROT_ARG_INTVAL:
- CTX_REG_INT(st->dest.ctx, idx) = UVal_int(st->val);
- break;
- case PARROT_ARG_FLOATVAL:
- CTX_REG_NUM(st->dest.ctx, idx) = UVal_num(st->val);
- break;
- case PARROT_ARG_STRING:
- CTX_REG_STR(st->dest.ctx, idx) = UVal_str(st->val);
- break;
- case PARROT_ARG_PMC:
- CTX_REG_PMC(st->dest.ctx, idx) = UVal_pmc(st->val);
- break;
- default:
- break;
- }
-}
-
-
-/*
-
-=item C<int Parrot_store_arg>
-
-Stores the next function argument into the appropriate destination register.
-Calls C<store_arg> to do most of the work. Returns 0 if an attempt is made
-to store more values then there are in the signature. Returns 1 otherwise.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-int
-Parrot_store_arg(SHIM_INTERP, ARGIN(const call_state *st))
-{
- ASSERT_ARGS(Parrot_store_arg)
- INTVAL idx;
- if (st->dest.i >= st->dest.n)
- return 0;
-
- PARROT_ASSERT(st->dest.mode & CALL_STATE_OP);
- idx = st->dest.u.op.pc[st->dest.i];
- PARROT_ASSERT(idx >= 0);
- store_arg(st, idx);
-
- return 1;
-}
-
-
-/*
-
-=item C<static void too_few>
-
-Throws an exception if there are too few arguments passed.
-
-=cut
-
-*/
-
-static void
-too_few(PARROT_INTERP, ARGIN(const call_state *st), ARGIN(const char *action))
-{
- ASSERT_ARGS(too_few)
- const int max_expected_args = st->params;
- const int min_expected_args = max_expected_args - st->optionals;
-
- if (st->n_actual_args < min_expected_args) {
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "too few arguments passed (%d) - %s%d %s expected",
- st->n_actual_args,
- (min_expected_args < max_expected_args ? "at least " : ""),
- min_expected_args, action);
- }
-}
-
-
-/*
-
-=item C<static void too_many>
-
-Throws an exception if there are too many arguments passed.
-
-=cut
-
-*/
-
-static void
-too_many(PARROT_INTERP, ARGIN(const call_state *st), ARGIN(const char *action))
-{
- ASSERT_ARGS(too_many)
- const int max_expected_args = st->params;
- const int min_expected_args = max_expected_args - st->optionals;
-
- if (st->n_actual_args > max_expected_args) {
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "too many arguments passed (%d) - %s%d %s expected",
- st->n_actual_args,
- (min_expected_args < max_expected_args ? "at most " : ""),
- max_expected_args, action);
- }
-}
-
-
-/*
-
-=item C<static void null_val>
-
-Adds a null value to the appropriate register.
-
-=cut
-
-*/
-
-static void
-null_val(int sig, ARGMOD(call_state *st))
-{
- ASSERT_ARGS(null_val)
- switch (sig & PARROT_ARG_TYPE_MASK) {
- case PARROT_ARG_INTVAL: UVal_int(st->val) = 0; break;
- case PARROT_ARG_FLOATVAL: UVal_num(st->val) = 0.0; break;
- case PARROT_ARG_STRING: UVal_str(st->val) = NULL; break;
- case PARROT_ARG_PMC: UVal_pmc(st->val) = PMCNULL; break;
- default:
- break;
- }
-}
-
-
-/*
-
-=item C<static void check_named>
-
-Makes sure that all required named args are set and that all optional
-args and flags are set to null and false if not present.
-
-A named arg takes the form of
-
- STRING* name, [INPS] actual_arg,
-
-or
-
- STRING* name, [INPS] actual_arg, int opt_arg_flag
-
-=cut
-
-*/
-
-static void
-check_named(PARROT_INTERP, ARGMOD(call_state *st))
-{
- ASSERT_ARGS(check_named)
- int i;
- int n_named = -1;
-
- for (i = st->first_named; i < st->dest.n; ++i) {
- /* verify that a name exists */
- const INTVAL sig = st->dest.sig =
- VTABLE_get_integer_keyed_int(interp, st->dest.u.op.signature, i);
- if (sig & PARROT_ARG_NAME) {
- INTVAL arg_sig;
- int last_name_pos;
-
- /* if slurpy then no errors, return */
- if (sig & PARROT_ARG_SLURPY_ARRAY)
- return;
-
- n_named++;
- last_name_pos = i;
-
- /* move on to the actual arg */
- i++;
-
- /* verify that an actual arg exists */
- arg_sig = st->dest.sig = VTABLE_get_integer_keyed_int(interp,
- st->dest.u.op.signature, i);
- PARROT_ASSERT(!(arg_sig & PARROT_ARG_NAME));
-
- /* if this named arg is already filled, continue */
- if (st->named_done & (1 << n_named)) {
- if (i + 1 < st->dest.n) {
- arg_sig = st->dest.sig = VTABLE_get_integer_keyed_int(interp,
- st->dest.u.op.signature, i + 1);
-
- /* skip associated opt flag arg as well */
- if (arg_sig & PARROT_ARG_OPT_FLAG)
- i++;
- }
-
- continue;
- }
- else if (arg_sig & PARROT_ARG_OPTIONAL) {
- INTVAL idx;
- null_val(arg_sig, st);
- idx = st->dest.u.op.pc[i];
- store_arg(st, idx);
-
- /* Don't walk off the end of the array */
- if (i+1 >= st->dest.n)
- continue;
- arg_sig = st->dest.sig = VTABLE_get_integer_keyed_int(interp,
- st->dest.u.op.signature, i+1);
- if (arg_sig & PARROT_ARG_OPT_FLAG) {
- i++;
- idx = st->dest.u.op.pc[i];
- CTX_REG_INT(st->dest.ctx, idx) = 0;
- }
- continue;
- }
- else {
- const INTVAL idx = st->dest.u.op.pc[last_name_pos];
- STRING * const param = PARROT_ARG_CONSTANT_ISSET(sig)
- ? st->dest.ctx->constants[idx]->u.string
- : CTX_REG_STR(st->dest.ctx, idx);
-
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "too few arguments passed"
- " - missing required named arg '%Ss'", param);
- }
- }
- else
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "invalid arg type in named portion of args");
- }
-}
-
-
-/*
-
-=item C<static void init_call_stats>
-
-Sets the default values of the passed C<call_state>.
-
-=cut
-
-*/
-
-static void
-init_call_stats(ARGMOD(call_state *st))
-{
- ASSERT_ARGS(init_call_stats)
- /* initial guess, adjusted for :flat args */
- st->n_actual_args = st->src.n;
-
- st->optionals = 0;
- st->params = st->dest.n;
- st->name = NULL;
- st->key = PMCNULL;
- st->first_named = -1;
-}
-
-
-/*
-
-=item C<void Parrot_process_args>
-
-Gets args for the current function call and puts them into position.
-First it gets the positional non-slurpy parameters, then the positional
-slurpy parameters, and finally the named parameters.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_process_args(PARROT_INTERP, ARGMOD(call_state *st), arg_pass_t param_or_result)
-{
- ASSERT_ARGS(Parrot_process_args)
- int n_named;
- int err_check = 1;
- call_state_item *src, *dest;
-
- const char * const action = (param_or_result == PARROT_PASS_RESULTS)
- ? "results" : "params";
-
- /* Check if we should be throwing errors. This can be configured separately
- * for parameters and return values. */
- if (param_or_result == PARROT_PASS_RESULTS) {
- if (!PARROT_ERRORS_test(interp, PARROT_ERRORS_RESULT_COUNT_FLAG))
- err_check = 0;
- }
- else if (!PARROT_ERRORS_test(interp, PARROT_ERRORS_PARAM_COUNT_FLAG))
- err_check = 0;
-
- init_call_stats(st);
-
- src = &st->src;
- dest = &st->dest;
-
- /* 1st: Positional non-:slurpy */
- for (; dest->i < dest->n; dest->i++) {
- INTVAL idx;
- int has_arg;
-
- /* check if the next dest arg is :slurpy */
- next_arg_sig(interp, dest);
- if (dest->sig & PARROT_ARG_SLURPY_ARRAY)
- break;
-
- /* Check if there is another argument. We need to store the value to
- * handle :opt_flag, which needs to know if there was a preceding
- * argument. */
- has_arg = Parrot_fetch_arg(interp, st);
-
- /* if the src arg is named, we're done here */
- if (st->name) {
- /* but first, take care of any :optional arguments */
-
- /*
- * Workaround for several argument passing problems
- * RT #54860 and others
- * Save current value while setting the optional
- */
- UnionVal old_value;
- old_value = st->val;
-
- while (dest->sig & PARROT_ARG_OPTIONAL) {
- null_val(st->dest.sig, st);
-
- /* actually store the argument */
- idx = st->dest.u.op.pc[st->dest.i];
- PARROT_ASSERT(idx >= 0);
- store_arg(st, idx);
-
- check_for_opt_flag(interp, st, 0);
-
- /* next dest arg */
- dest->i++;
- next_arg_sig(interp, dest);
- }
-
- /* Restore value */
- st->val = old_value;
-
- break;
- }
-
- /* if the dest is a named argument, we need to fill it as a positional
- * since no named arguments have been given. so skip the name. */
- if (dest->sig & PARROT_ARG_NAME) {
- if (!has_arg)
- break;
- dest->i++;
- next_arg_sig(interp, dest);
- }
-
- /* if there *is* an arg, convert it */
- if (has_arg) {
- src->used = 1;
- Parrot_convert_arg(interp, st);
- }
-
- /* if this is an optional argument, null it */
- else if (dest->sig & PARROT_ARG_OPTIONAL)
- null_val(st->dest.sig, st);
-
- /* there's no argument - throw an exception (if we're in to that) */
- else if (err_check)
- too_few(interp, st, action);
-
- /* otherwise, we're done */
- else
- return;
-
- /* actually store the argument */
- idx = st->dest.u.op.pc[st->dest.i];
- PARROT_ASSERT(idx >= 0);
- store_arg(st, idx);
-
- /* if we're at an :optional argument, check for an :opt_flag */
- if (dest->sig & PARROT_ARG_OPTIONAL)
- check_for_opt_flag(interp, st, has_arg);
- }
-
- /* 2nd: Positional :slurpy */
- if (dest->sig & PARROT_ARG_SLURPY_ARRAY && !(dest->sig & PARROT_ARG_NAME)) {
- PMC * const array = pmc_new(interp,
- Parrot_get_ctx_HLL_type(interp, enum_class_ResizablePMCArray));
- const INTVAL idx = st->dest.u.op.pc[dest->i];
-
- PARROT_ASSERT(idx >= 0);
-
- /* Must register this PMC or it may get collected when only the struct
- * references it. */
- CTX_REG_PMC(st->dest.ctx, idx) = array;
-
- while (Parrot_fetch_arg(interp, st)) {
- /* if the src arg is named, we're done here */
- if (st->name)
- break;
-
- src->used = 1;
-
- /* we have to convert to a PMC so we can put it in the PMC array */
- dest->sig |= PARROT_ARG_PMC;
- Parrot_convert_arg(interp, st);
-
- VTABLE_push_pmc(interp, array, UVal_pmc(st->val));
- }
-
- dest->i++;
- }
-
- /* is there another argument? if we're throwing errors, that's an error */
- if (err_check && Parrot_fetch_arg(interp, st)
- && !st->name && !(dest->sig & PARROT_ARG_NAME))
- too_many(interp, st, action);
-
- /* are we at the end? */
- if (dest->i == dest->n)
- return;
-
- /* 3rd: :named */
- init_first_dest_named(interp, st);
- n_named = 0;
-
- while (Parrot_fetch_arg(interp, st)) {
- src->used = 1;
-
- if (!st->name)
- Parrot_ex_throw_from_c_args(interp, NULL, 0,
- "positional inside named args at position %i",
- st->src.i - n_named);
-
- if (!locate_named_named(interp, st))
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "too many named arguments - '%Ss' not expected", st->name);
-
- n_named++;
-
- /* if the dest arg is :named :slurpy */
- if (dest->sig & PARROT_ARG_SLURPY_ARRAY) {
- /* Convert to a PMC to store in the hash */
- dest->sig |= PARROT_ARG_PMC;
- Parrot_convert_arg(interp, st);
- VTABLE_set_pmc_keyed_str(interp, dest->slurp, st->name, UVal_pmc(st->val));
- }
- else {
- Parrot_convert_arg(interp, st);
- Parrot_store_arg(interp, st);
-
- /* if we're at an :optional argument, check for an :opt_flag */
- if (dest->sig & PARROT_ARG_OPTIONAL)
- check_for_opt_flag(interp, st, 1);
- }
-
- /* otherwise this doesn't get reset and we can't catch positional args
- * inside of named args */
- st->name = NULL;
- }
-
- check_named(interp, st);
-}
-
-
-/*
-
-=item C<void Parrot_convert_arg>
-
-Converts a source argument to the expected destination type.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_convert_arg(PARROT_INTERP, ARGMOD(call_state *st))
-{
- ASSERT_ARGS(Parrot_convert_arg)
- /* register key args have to be cloned */
- if ((st->src.sig & PARROT_ARG_TYPE_MASK) == PARROT_ARG_PMC)
- clone_key_arg(interp, st);
-
- /* if types are already equivalent, no need to convert */
- if (PARROT_ARG_TYPE(st->dest.sig) == PARROT_ARG_TYPE(st->src.sig))
- return;
-
- /* convert */
- switch (st->src.sig & PARROT_ARG_TYPE_MASK) {
- case PARROT_ARG_INTVAL: convert_arg_from_int(interp, st); break;
- case PARROT_ARG_FLOATVAL: convert_arg_from_num(interp, st); break;
- case PARROT_ARG_STRING: convert_arg_from_str(interp, st); break;
- case PARROT_ARG_PMC: convert_arg_from_pmc(interp, st); break;
- default:
- break;
- }
-}
-
-
-/*
-
-=item C<void parrot_pass_args>
-
-Main argument passing routine.
-
-Prelims: code segments aren't yet switched, so the current constants are still
-that of the caller. The destination context is already created and set,
-C<src_ctx> point to the caller's context. C<dst_seg> has the constants of the
-destination.
-
-C<what> is either C<PARROT_OP_get_params_pc> or C<PARROT_OP_get_results_pc>.
-With the former arguments are passed from the caller into a subroutine, the
-latter handles return values and yields.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-parrot_pass_args(PARROT_INTERP,
- ARGMOD(Parrot_Context *src_ctx), ARGMOD(Parrot_Context *dest_ctx),
- ARGMOD_NULLOK(opcode_t *src_indexes), ARGMOD_NULLOK(opcode_t *dest_indexes),
- arg_pass_t param_or_result)
-{
- ASSERT_ARGS(parrot_pass_args)
- call_state st;
- PMC *src_signature, *dest_signature;
-
- if (param_or_result == PARROT_PASS_PARAMS) {
- src_signature = interp->args_signature;
- dest_signature = interp->params_signature;
- interp->args_signature = NULL;
- interp->params_signature = NULL;
- }
- else /* (param_or_result == PARROT_PASS_RESULTS) */ {
- src_signature = interp->returns_signature;
- dest_signature = dest_ctx->results_signature;
- interp->returns_signature = NULL;
- dest_ctx->results_signature = NULL;
- }
-
- Parrot_init_arg_indexes_and_sig_pmc(interp, src_ctx, src_indexes,
- src_signature, &st.src);
-
- Parrot_init_arg_indexes_and_sig_pmc(interp, dest_ctx, dest_indexes,
- dest_signature, &st.dest);
-
- Parrot_process_args(interp, &st, param_or_result);
-
- /* If we created a slurpy, we had to DOD register it so it did not get
- * collected during arg processing; we'll now unregister it. */
-}
-
-
-/*
-
-=item C<opcode_t * parrot_pass_args_fromc>
-
-Passes arguments from C code with given signature to a Parrot Sub.
-Prerequisites are like above.
-
-=cut
-
-*/
-
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-opcode_t *
-parrot_pass_args_fromc(PARROT_INTERP, ARGIN(const char *sig),
- ARGMOD(opcode_t *dest), ARGIN(Parrot_Context *old_ctxp), va_list ap)
-{
- ASSERT_ARGS(parrot_pass_args_fromc)
- call_state st;
-
- Parrot_init_arg_op(interp, CONTEXT(interp), dest, &st.dest);
- Parrot_init_arg_sig(interp, old_ctxp, sig, PARROT_VA_TO_VAPTR(ap), &st.src);
- Parrot_process_args(interp, &st, PARROT_PASS_PARAMS);
- return dest + st.dest.n + 2;
-}
-
-
-/*
-
-=item C<static int set_retval_util>
-
-Adds the current return parameter to the current context, and fetches
-the next return parameter from the call state object.
-
-=cut
-
-*/
-
-static int
-set_retval_util(PARROT_INTERP, ARGIN(const char *sig),
- ARGIN(Parrot_Context *ctx), ARGMOD(call_state *st))
-{
- ASSERT_ARGS(set_retval_util)
- opcode_t * const src_pc = interp->current_returns;
- int todo = Parrot_init_arg_op(interp, ctx, src_pc, &st->src);
-
- interp->current_returns = NULL;
-
- if (todo) {
- todo = Parrot_init_arg_sig(interp, CONTEXT(interp), sig, NULL,
- &st->dest);
-
- if (todo) {
- Parrot_fetch_arg(interp, st);
- Parrot_convert_arg(interp, st);
- return 1;
- }
- }
-
- return 0;
-}
-
-
-/*
-
-=item C<void * set_retval>
-
-Handles void and pointer (PMC *, STRING *) return values. Returns a PMC,
-STRING, or NULL pointer as appropriate.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-void *
-set_retval(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
-{
- ASSERT_ARGS(set_retval)
- call_state st;
-
- if (!sig_ret || sig_ret == 'v')
- return NULL;
-
- switch (sig_ret) {
- case 'S':
- if (set_retval_util(interp, "S", ctx, &st))
- return UVal_str(st.val);
- case 'P':
- if (set_retval_util(interp, "P", ctx, &st)) {
- PMC *retval = UVal_pmc(st.val);
- return (void *)retval;
- }
- default:
- return NULL;
- }
-}
-
-
-/*
-
-=item C<INTVAL set_retval_i>
-
-Handles an INTVAL return value, returning its value if present and 0 otherwise.
-
-=cut
-
-*/
-
-INTVAL
-set_retval_i(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
-{
- ASSERT_ARGS(set_retval_i)
- call_state st;
-
- if (sig_ret != 'I')
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "return signature not 'I'");
-
- if (set_retval_util(interp, "I", ctx, &st))
- return UVal_int(st.val);
-
- return 0;
-}
-
-
-/*
-
-=item C<FLOATVAL set_retval_f>
-
-Handles a FLOATVAL return value, returning its value if present and 0.0
-otherwise.
-
-=cut
-
-*/
-
-FLOATVAL
-set_retval_f(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
-{
- ASSERT_ARGS(set_retval_f)
- call_state st;
-
- if (sig_ret != 'N')
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "return signature not 'N'");
-
- if (set_retval_util(interp, "N", ctx, &st))
- return UVal_num(st.val);
-
- return 0.0;
-}
-
-
-/*
-
-=item C<STRING* set_retval_s>
-
-Handles a STRING return value, returning its pointer if present and NULL
-otherwise.
-
-=cut
-
-*/
-
-PARROT_CAN_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-STRING*
-set_retval_s(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
-{
- ASSERT_ARGS(set_retval_s)
- call_state st;
-
- if (sig_ret != 'S')
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "return signature not 'S'");
-
- if (set_retval_util(interp, "S", ctx, &st))
- return UVal_str(st.val);
-
- return NULL;
-}
-
-
-/*
-
-=item C<PMC* set_retval_p>
-
-Handles a PMC return value, returning the PMC pointer if present and NULL
-otherwise.
-
-=cut
-
-*/
-
-PARROT_CAN_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-PMC*
-set_retval_p(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
-{
- ASSERT_ARGS(set_retval_p)
- call_state st;
-
- if (sig_ret != 'P')
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "return signature not 'P'");
-
- if (set_retval_util(interp, "P", ctx, &st))
- return UVal_pmc(st.val);
-
- return NULL;
-}
-
-
-/*
-
-=item C<static void commit_last_arg>
-
-Called by C<Parrot_PCCINVOKE> when it reaches the end of each arg in the arg
-signature. See C<Parrot_PCCINVOKE> for signature syntax.
-
-=cut
-
-*/
-
-static void
-commit_last_arg(PARROT_INTERP, int index, int cur,
- ARGMOD(opcode_t *n_regs_used), int seen_arrow, ARGIN(PMC * const *sigs),
- ARGMOD(opcode_t **indexes), ARGMOD(Parrot_Context *ctx),
- ARGIN_NULLOK(PMC *pmc), ARGIN(va_list *list))
-{
- ASSERT_ARGS(commit_last_arg)
- int reg_offset = 0;
-
- /* invocant already commited, just return */
- if (seen_arrow == 0 && index == 0 && pmc)
- return;
-
- /* calculate arg's register offset */
- switch (cur & PARROT_ARG_TYPE_MASK) { /* calc reg offset */
- case PARROT_ARG_INTVAL:
- reg_offset = n_regs_used[seen_arrow * 4 + REGNO_INT]++; break;
- case PARROT_ARG_FLOATVAL:
- reg_offset = n_regs_used[seen_arrow * 4 + REGNO_NUM]++; break;
- case PARROT_ARG_STRING:
- reg_offset = n_regs_used[seen_arrow * 4 + REGNO_STR]++; break;
- case PARROT_ARG_PMC :
- reg_offset = n_regs_used[seen_arrow * 4 + REGNO_PMC]++; break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "Parrot_PCCINVOKE: invalid reg type");
- }
-
- /* set the register offset into the index int[] */
- indexes[seen_arrow][index] = reg_offset;
-
- /* set the PARROT_ARG_FLAGS into the signature FIA */
- VTABLE_set_integer_keyed_int(interp, sigs[seen_arrow], index, cur);
-
- /* perform the arg accessor function, assigning the arg to its
- * corresponding register */
- if (!seen_arrow) {
- switch (cur & PARROT_ARG_TYPE_MASK) {
- case PARROT_ARG_INTVAL:
- CTX_REG_INT(ctx, reg_offset) = va_arg(*list, INTVAL); break;
- case PARROT_ARG_FLOATVAL:
- CTX_REG_NUM(ctx, reg_offset) = va_arg(*list, FLOATVAL); break;
- case PARROT_ARG_STRING:
- CTX_REG_STR(ctx, reg_offset) = va_arg(*list, STRING *); break;
- case PARROT_ARG_PMC:
- CTX_REG_PMC(ctx, reg_offset) = va_arg(*list, PMC *); break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "Parrot_PCCINVOKE: invalid reg type");
- }
- }
-}
-
-/*
-
-=item C<static Parrot_Context * count_signature_elements>
-
-Counts the number of each type of register in a signature object. Returns
-the total number of parameter arguments, the total number of result
-arguments, and the number of each type needed for register allocation.
-Adds the necessary registers to a new context and returns the context.
-
-=cut
-
-*/
-
-PARROT_CANNOT_RETURN_NULL
-static Parrot_Context *
-count_signature_elements(PARROT_INTERP, ARGIN(const char *signature),
- ARGMOD(PMC *args_sig), ARGMOD(PMC *results_sig), int flag)
-{
- ASSERT_ARGS(count_signature_elements)
- const char *x;
- unsigned int seen_arrow = 0;
-
- /*Count of number of each type of arg and result, INSP->INSP */
- int max_regs[8] = { 0, 0, 0, 0, 0, 0, 0, 0 };
-
- /* variables from PCCINVOKE impl in PCCMETHOD.pm */
- /* args INSP, returns INSP */
- INTVAL n_regs_used[] = { 0, 0, 0, 0, 0, 0, 0, 0 };
-
- /* # of args, # of results */
- int arg_ret_cnt[2] = { 0, 0 };
-
- /* Increment these values if we are not calling from a CallSignature
- PMC */
- if (flag) {
- arg_ret_cnt[seen_arrow]++;
- max_regs[REGNO_PMC]++;
- }
-
- /* Loop through the signature string to count the number of each
- type of object required. We need to know so we can allocate
- an appropriate number of registers for it. */
- for (x = signature; *x != '\0'; x++) {
- switch (*x) {
- case '-':
- /* detect -> separator */
- seen_arrow = 1;
- ++x;
- if (*x != '>')
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "PCCINVOKE: invalid signature separator %c!",
- *x);
- break;
- case 'I':
- arg_ret_cnt[seen_arrow]++;
- max_regs[seen_arrow * 4 + REGNO_INT]++;
- break;
- case 'N':
- arg_ret_cnt[seen_arrow]++;
- max_regs[seen_arrow * 4 + REGNO_NUM]++;
- break;
- case 'S':
- arg_ret_cnt[seen_arrow]++;
- max_regs[seen_arrow * 4 + REGNO_STR]++;
- break;
- case 'P':
- arg_ret_cnt[seen_arrow]++;
- {
- /* Lookahead to see if PMC is marked as invocant */
- if (*(++x) == 'i') {
- max_regs[REGNO_PMC]++;
- }
- else {
- x--; /* Undo lookahead */
- max_regs[seen_arrow * 4 + REGNO_PMC]++;
- }
- }
- break;
- case 'f':
- case 'n':
- case 's':
- case 'o':
- case 'p':
- /* case 'l': */ /* lookahead parameter */
- case 'i':
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "Parrot_PCCINVOKE: invalid reg type %c!", *x);
- }
- }
-
- /* calculate max reg types needed for both args and results */
- n_regs_used[0] = PARROT_MAX(max_regs[0], max_regs[4]);
- n_regs_used[1] = PARROT_MAX(max_regs[1], max_regs[5]);
- n_regs_used[2] = PARROT_MAX(max_regs[2], max_regs[6]);
- n_regs_used[3] = PARROT_MAX(max_regs[3], max_regs[7]);
-
- /* initialize arg and return sig FIAs with collected info */
- if (arg_ret_cnt[0] > 0)
- VTABLE_set_integer_native(interp, args_sig, arg_ret_cnt[0]);
-
- if (arg_ret_cnt[1] > 0)
- VTABLE_set_integer_native(interp, results_sig, arg_ret_cnt[1]);
-
- return Parrot_push_context(interp, n_regs_used);
-}
-
-/*
-
-=item C<static void commit_last_arg_sig_object>
-
-Called by Parrot_pcc_invoke_from_sig_object when it reaches the end of each
-arg in the arg signature. See C<Parrot_pcc_invoke_from_sig_object> for
-signature syntax.
-
-=cut
-
-*/
-
-static void
-commit_last_arg_sig_object(PARROT_INTERP, int index, int cur,
- ARGMOD(opcode_t *n_regs_used), int seen_arrow, ARGIN(PMC * const *sigs),
- ARGMOD(opcode_t **indexes), ARGMOD(Parrot_Context *ctx),
- ARGIN(PMC *sig_obj))
-{
- ASSERT_ARGS(commit_last_arg_sig_object)
- int reg_offset = 0;
-
- /* calculate arg's register offset */
- switch (cur & PARROT_ARG_TYPE_MASK) { /* calc reg offset */
- case PARROT_ARG_INTVAL:
- reg_offset = n_regs_used[seen_arrow * 4 + REGNO_INT]++; break;
- case PARROT_ARG_FLOATVAL:
- reg_offset = n_regs_used[seen_arrow * 4 + REGNO_NUM]++; break;
- case PARROT_ARG_STRING:
- reg_offset = n_regs_used[seen_arrow * 4 + REGNO_STR]++; break;
- case PARROT_ARG_PMC :
- if (cur & PARROT_ARG_INVOCANT) {
- if (seen_arrow == 0 && index == 0) {
- n_regs_used[REGNO_PMC]++;
- reg_offset = 0;
- }
- else {
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "Parrot_pcc_invoke: Only the first parameter can be an invocant %d, %d",
- seen_arrow, index);
- }
- }
- else {
- reg_offset = n_regs_used[seen_arrow * 4 + REGNO_PMC]++;
- }
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "Parrot_PCCINVOKE: invalid reg type");
- }
-
- /* set the register offset into the index int[] */
- indexes[seen_arrow][index] = reg_offset;
-
- /* set the PARROT_ARG_FLAGS into the signature FIA */
- VTABLE_set_integer_keyed_int(interp, sigs[seen_arrow], index, cur);
-
- /* perform the arg accessor function, assigning the arg to its
- * corresponding register */
- if (!seen_arrow) {
- switch (cur & PARROT_ARG_TYPE_MASK) {
- case PARROT_ARG_INTVAL:
- CTX_REG_INT(ctx, reg_offset) = VTABLE_get_integer_keyed_int(interp, sig_obj, index);
- break;
- case PARROT_ARG_FLOATVAL:
- CTX_REG_NUM(ctx, reg_offset) = VTABLE_get_number_keyed_int(interp, sig_obj, index);
- break;
- case PARROT_ARG_STRING:
- CTX_REG_STR(ctx, reg_offset) = VTABLE_get_string_keyed_int(interp, sig_obj, index);
- break;
- case PARROT_ARG_PMC:
- CTX_REG_PMC(ctx, reg_offset) = VTABLE_get_pmc_keyed_int(interp, sig_obj, index);
- if (cur & PARROT_ARG_INVOCANT) {
- interp->current_object = CTX_REG_PMC(ctx, reg_offset);
- }
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "Parrot_pcc_invoke_from_sig_object: invalid reg type");
- }
- }
-}
-
-/*
-
-=item C<static void set_context_sig_returns>
-
-Sets the subroutine return arguments in the context C<ctx>. Takes a C string
-for the return signature C<ret_x> and a list of return parameters C<result_list>.
-
-=cut
-
-*/
-
-static void
-set_context_sig_returns(PARROT_INTERP,
- ARGMOD(Parrot_Context *ctx), ARGMOD(opcode_t **indexes),
- ARGIN_NULLOK(const char *ret_x), ARGMOD(PMC *result_list))
-{
- ASSERT_ARGS(set_context_sig_returns)
- const char *x;
- STRING *empty_string = CONST_STRING(interp, "");
- unsigned int index = 0;
- unsigned int seen_arrow = 1;
-
- /* result_accessors perform the arg accessor function,
- * assigning the corresponding registers to the result variables */
- for (x = ret_x; x && *x; x++) {
- PMC *result_item = VTABLE_get_pmc_keyed_int(interp, result_list, index);
- if (isupper((unsigned char)*x)) {
- switch (*x) {
- case 'I':
- {
- VTABLE_set_integer_native(interp, result_item,
- CTX_REG_INT(ctx, indexes[seen_arrow][index]));
- }
- break;
- case 'N':
- {
- VTABLE_set_number_native(interp, result_item,
- CTX_REG_NUM(ctx, indexes[seen_arrow][index]));
- }
- break;
- case 'S':
- {
- VTABLE_set_string_native(interp, result_item,
- CTX_REG_STR(ctx, indexes[seen_arrow][index]));
- }
- break;
- case 'P':
- {
- VTABLE_set_pmc(interp, result_item,
- CTX_REG_PMC(ctx, indexes[seen_arrow][index]));
- }
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "Parrot_pcc_invoke_from_sig_object: invalid reg type %c!", *x);
- }
-
- /* invalidate the CPointer's pointers so that GC doesn't try to
- * mark stack values -- RT #59880*/
- VTABLE_set_string_keyed_str(interp, result_item,
- empty_string, empty_string);
- }
- }
-
- Parrot_pop_context(interp);
-}
-
-/*
-
-=item C<static void set_context_sig_returns_varargs>
-
-Sets the subroutine return arguments in the context C<ctx>. Takes a C string
-for the return signature C<ret_x> and a varargs list of return parameters C<returns>.
-
-To unify this function with C<set_context_sig_returns>, C<Parrot_PCCINVOKE>
-needs to be changed to convert the va_list of input arguments into a signature
-object, and the results list from that object needs to be passed to this
-function instead of the va_list itself.
-
-=cut
-
-*/
-
-static void
-set_context_sig_returns_varargs(PARROT_INTERP, ARGMOD(Parrot_Context *ctx),
- ARGMOD(opcode_t **indexes), ARGIN(const char *ret_x), ARGMOD(va_list returns))
-{
- ASSERT_ARGS(set_context_sig_returns_varargs)
- unsigned int index = 0;
- unsigned int seen_arrow = 1;
- const char *x;
-
- /* result_accessors perform the arg accessor function,
- * assigning the corresponding registers to the result variables */
- for (x = ret_x; x && *x; x++) {
- if (isupper((unsigned char)*x)) {
- switch (*x) {
- case 'I':
- {
- INTVAL * const tmpINTVAL = va_arg(returns, INTVAL*);
- *tmpINTVAL = CTX_REG_INT(ctx, indexes[seen_arrow][index]);
- }
- break;
- case 'N':
- {
- FLOATVAL * const tmpFLOATVAL = va_arg(returns, FLOATVAL*);
- *tmpFLOATVAL = CTX_REG_NUM(ctx, indexes[seen_arrow][index]);
- }
- break;
- case 'S':
- {
- STRING ** const tmpSTRING = va_arg(returns, STRING**);
- *tmpSTRING = CTX_REG_STR(ctx, indexes[seen_arrow][index]);
- }
- break;
- case 'P':
- {
- PMC ** const tmpPMC = va_arg(returns, PMC**);
- *tmpPMC = CTX_REG_PMC(ctx, indexes[seen_arrow][index]);
- }
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "Parrot_PCCINVOKE: invalid reg type %c!", *x);
- }
- }
- }
- Parrot_pop_context(interp);
-}
-
-/*
-
-=item C<static const char * set_context_sig_params>
-
-Sets the subroutine arguments in the C<ctx> context, according to the
-signature string C<signature>. Currently this function is only called
-from C<Parrot_pcc_invoke_from_sig_object>, but eventually when
-things are unified enough it should be called from C<Parrot_PCCINVOKE>
-as well. The only difference currently between the two implementations
-are the calls to C<commit_last_arg_sig_object> and C<commit_last_arg>.
-
-=cut
-
-*/
-
-PARROT_CAN_RETURN_NULL
-static const char *
-set_context_sig_params(PARROT_INTERP, ARGIN(const char *signature),
- ARGMOD(INTVAL *n_regs_used), ARGMOD(PMC **sigs),
- ARGMOD(opcode_t **indexes), ARGMOD(Parrot_Context *ctx),
- ARGMOD(PMC *sig_obj))
-{
- ASSERT_ARGS(set_context_sig_params)
- /* second loop through signature to build all index and arg_flag
- * loop also assigns args(up to the ->) to registers */
- int index = -1;
- int seen_arrow = 0;
- int cur = 0;
- const char *ret_x = 0;
- const char *x;
-
- for (x = signature; *x != '\0'; x++) {
- /* detect -> separator */
- if (*x == '-') {
-
- /* skip '>' */
- x++;
-
- /* allows us to jump directly to the result signature portion
- * during results assignment */
- ret_x = x;
-
- /* save off pointer to results */
- ret_x++;
-
- if (index >= 0)
- commit_last_arg_sig_object(interp, index, cur, n_regs_used,
- seen_arrow, sigs, indexes, ctx, sig_obj);
-
- /* reset parsing state so we can now handle results */
- seen_arrow = 1;
- index = -1;
-
- /* reset n_regs_used for reuse during result index allocation */
- n_regs_used[0] = 0;
- n_regs_used[1] = 0;
- n_regs_used[2] = 0;
- n_regs_used[3] = 0;
- }
- /* parse arg type */
- else if (isupper((unsigned char)*x)) {
- if (index >= 0)
- commit_last_arg_sig_object(interp, index, cur, n_regs_used, seen_arrow,
- sigs, indexes, ctx, sig_obj);
-
- index++;
-
- switch (*x) {
- case 'I': cur = PARROT_ARG_INTVAL; break;
- case 'N': cur = PARROT_ARG_FLOATVAL; break;
- case 'S': cur = PARROT_ARG_STRING; break;
- case 'P': cur = PARROT_ARG_PMC; break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "Parrot_pcc_invoke_from_sig_object: invalid reg type %c!", *x);
- }
-
- }
- /* parse arg adverbs */
- else if (islower((unsigned char)*x)) {
- switch (*x) {
- case 'n': cur |= PARROT_ARG_NAME; break;
- case 'f': cur |= PARROT_ARG_FLATTEN; break;
- case 's': cur |= PARROT_ARG_SLURPY_ARRAY; break;
- case 'o': cur |= PARROT_ARG_OPTIONAL; break;
- case 'p': cur |= PARROT_ARG_OPT_FLAG; break;
- case 'l': cur |= PARROT_ARG_LOOKAHEAD; break;
- case 'i': cur |= PARROT_ARG_INVOCANT; break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "Parrot_pcc_invoke_from_sig_object: invalid adverb type %c!", *x);
- }
- }
- }
-
- if (index >= 0)
- commit_last_arg_sig_object(interp, index, cur, n_regs_used, seen_arrow, sigs,
- indexes, ctx, sig_obj);
-
- interp->current_args = indexes[0];
- interp->args_signature = sigs[0];
- ctx->current_results = indexes[1];
- ctx->results_signature = sigs[1];
- return ret_x;
-}
-
-/*
-
-=item C<void Parrot_pcc_invoke_sub_from_c_args>
-
-Follows the same conventions as C<Parrot_PCCINVOKE>, but the subroutine object
-to invoke is passed as an argument rather than looked up by name. The signature
-string and call arguments are converted to a CallSignature PMC.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_pcc_invoke_sub_from_c_args(PARROT_INTERP, ARGIN(PMC *sub_obj),
- ARGIN(const char *sig), ...)
-{
- ASSERT_ARGS(Parrot_pcc_invoke_sub_from_c_args)
- PMC *sig_obj;
- va_list args;
- va_start(args, sig);
- sig_obj = Parrot_build_sig_object_from_varargs(interp, PMCNULL, sig, args);
- va_end(args);
-
- Parrot_pcc_invoke_from_sig_object(interp, sub_obj, sig_obj);
-}
-
-/*
-
-=item C<void Parrot_PCCINVOKE>
-
-C<pmc> is the invocant.
-
-C<method_name> is the same C<method_name> used in the C<find_method>
-VTABLE call
-
-C<signature> is a C string describing the Parrot calling conventions for
-Parrot_PCCINVOKE. ... variable args contains the IN arguments followed
-by the OUT results variables. You must pass the address_of(&) the OUT
-results, of course.
-
-Signatures:
- uppercase letters repesent each arg and denote its types
-
- I INTVAL
- N FLOATVAL
- S STRING *
- P PMC *
-
- lowercase letters are adverb modifiers to the preceeding uppercase arg
- identifier
-
- f flatten
- n named
- s slurpy
- o optional
- p opt flag
- l lookahead parameter (next positional, or next named if no positionals)
- i invocant
-
- -> is the separator between args and results, similar to type theory
- notation.
-
- Named args require two arg slots. The first is the name, the second the arg.
-
-Example signature:
-
- "SnIPf->INPs"
-
- The args to the method invocation are
- a named INTVAL: SnI
- a flattened PMC: Pf
-
- The results of the method invocation are
- a INTVAL: I
- a FLOATVAL: N
- a slurpy PMC: Ps
-
-invokes a PMC method
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_PCCINVOKE(PARROT_INTERP, ARGIN(PMC* pmc), ARGMOD(STRING *method_name),
- ARGIN(const char *signature), ...)
-{
- ASSERT_ARGS(Parrot_PCCINVOKE)
-#define PCC_ARG_MAX 1024
- /* variables from PCCINVOKE impl in PCCMETHOD.pm */
- /* args INSP, returns INSP */
- INTVAL n_regs_used[] = { 0, 0, 0, 0, 0, 0, 0, 0 };
-
- /* Each of these is 8K. Do we want 16K on the stack? */
- opcode_t arg_indexes[PCC_ARG_MAX];
- opcode_t result_indexes[PCC_ARG_MAX];
-
- PMC * const args_sig = pmc_new(interp, enum_class_FixedIntegerArray);
- PMC * const results_sig = pmc_new(interp, enum_class_FixedIntegerArray);
- PMC * const ret_cont = new_ret_continuation_pmc(interp, NULL);
-
- Parrot_Context *ctx; /* The newly created context */
- PMC *pccinvoke_meth;
-
- opcode_t *save_current_args;
- PMC *save_args_signature;
- PMC *save_current_object;
-
- /* temporary state vars for building PCC index and PCC signature arrays. */
-
- /* arg_indexes, result_indexes */
- opcode_t *indexes[2];
-
- /* args_sig, results_sig */
- PMC *sigs[2];
-
- int seen_arrow = 0;
-
- const char *x;
- const char *ret_x = NULL;
- int index = -1;
- int cur = 0;
-
- va_list list;
- va_start(list, signature);
-
- indexes[0] = arg_indexes;
- indexes[1] = result_indexes;
- sigs[0] = args_sig;
- sigs[1] = results_sig;
-
- /* account for passing invocant in-band */
- if (!pmc)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "NULL PMC passed into Parrot_PCCINVOKE");
-
- ctx = count_signature_elements(interp, signature, args_sig, results_sig, 1);
-
- /* second loop through signature to build all index and arg_flag
- * loop also assigns args(up to the ->) to registers */
-
- /* account for passing invocant in-band */
- indexes[0][0] = 0;
-
- VTABLE_set_integer_keyed_int(interp, sigs[0], 0, PARROT_ARG_PMC);
- CTX_REG_PMC(ctx, 0) = pmc;
-
- n_regs_used[REGNO_PMC]++;
- index = 0;
-
- for (x = signature; *x != '\0'; x++) {
- /* detect -> separator */
- if (*x == '-') {
-
- /* skip '>' */
- x++;
-
- /* allows us to jump directly to the result signature portion
- * during results assignment */
- ret_x = x;
-
- /* save off pointer to results */
- ret_x++;
-
- if (index >= 0)
- commit_last_arg(interp, index, cur, n_regs_used, seen_arrow,
- sigs, indexes, ctx, pmc, &list);
-
- /* reset parsing state so we can now handle results */
- seen_arrow = 1;
- index = -1;
-
- /* reset n_regs_used for reuse during result index allocation */
- n_regs_used[0] = 0;
- n_regs_used[1] = 0;
- n_regs_used[2] = 0;
- n_regs_used[3] = 0;
- }
- /* parse arg type */
- else if (isupper((unsigned char)*x)) {
- if (index >= 0)
- commit_last_arg(interp, index, cur, n_regs_used, seen_arrow,
- sigs, indexes, ctx, pmc, &list);
-
- index++;
-
- switch (*x) {
- case 'I': cur = PARROT_ARG_INTVAL; break;
- case 'N': cur = PARROT_ARG_FLOATVAL; break;
- case 'S': cur = PARROT_ARG_STRING; break;
- case 'P': cur = PARROT_ARG_PMC; break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "Parrot_PCCINVOKE: invalid reg type %c!", *x);
- }
-
- }
- /* parse arg adverbs */
- else if (islower((unsigned char)*x)) {
- switch (*x) {
- case 'n': cur |= PARROT_ARG_NAME; break;
- case 'f': cur |= PARROT_ARG_FLATTEN; break;
- case 's': cur |= PARROT_ARG_SLURPY_ARRAY; break;
- case 'o': cur |= PARROT_ARG_OPTIONAL; break;
- case 'p': cur |= PARROT_ARG_OPT_FLAG; break;
- /* case 'l': cur |= PARROT_ARG_LOOKAHEAD; break; */
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "Parrot_PCCINVOKE: invalid adverb type %c!", *x);
- }
- }
- }
-
- if (index >= 0)
- commit_last_arg(interp, index, cur, n_regs_used, seen_arrow, sigs,
- indexes, ctx, pmc, &list);
-
- /* code from PCCINVOKE impl in PCCMETHOD.pm */
- save_current_args = interp->current_args;
- save_args_signature = interp->args_signature;
- save_current_object = interp->current_object;
-
- interp->current_args = arg_indexes;
- interp->args_signature = args_sig;
- ctx->current_results = result_indexes;
- ctx->results_signature = results_sig;
-
- /* arg_accessors assigned in loop above */
-
- interp->current_object = pmc;
- interp->current_cont = NEED_CONTINUATION;
- ctx->current_cont = ret_cont;
- PMC_cont(ret_cont)->from_ctx = Parrot_context_ref(interp, ctx);
- pccinvoke_meth = VTABLE_find_method(interp, pmc, method_name);
-
- if (PMC_IS_NULL(pccinvoke_meth))
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_METHOD_NOT_FOUND,
- "Method '%Ss' not found", method_name);
- else
- VTABLE_invoke(interp, pccinvoke_meth, NULL);
-
- set_context_sig_returns_varargs(interp, ctx, indexes, ret_x, list);
- PObj_live_CLEAR(args_sig);
- PObj_live_CLEAR(results_sig);
- interp->current_args = save_current_args;
- interp->args_signature = save_args_signature;
- interp->current_object = save_current_object;
- va_end(list);
-}
-
-/*
-
-=item C<void Parrot_pcc_invoke_method_from_c_args>
-
-Makes a method call given the name of the method and the arguments as a
-C variadic argument list. C<pmc> is the invocant, C<method_name> is the
-string name of the method, C<signature> is a C string describing the
-signature of the invocation, according to the Parrot calling
-conventions. The variadic argument list contains the input arguments
-followed by the output results in the same order that they appear in the
-function signature.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_pcc_invoke_method_from_c_args(PARROT_INTERP, ARGIN(PMC* pmc),
- ARGMOD(STRING *method_name),
- ARGIN(const char *signature), ...)
-{
- ASSERT_ARGS(Parrot_pcc_invoke_method_from_c_args)
- PMC *sig_obj;
- PMC *sub_obj;
- va_list args;
- va_start(args, signature);
- sig_obj = Parrot_build_sig_object_from_varargs(interp, pmc, signature, args);
- va_end(args);
-
- /* Find the subroutine object as a named method on pmc */
- sub_obj = VTABLE_find_method(interp, pmc, method_name);
- if (PMC_IS_NULL(sub_obj))
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_METHOD_NOT_FOUND,
- "Method '%Ss' not found", method_name);
-
- /* Invoke the subroutine object with the given CallSignature object */
- Parrot_pcc_invoke_from_sig_object(interp, sub_obj, sig_obj);
- gc_unregister_pmc(interp, sig_obj);
-
-}
-
-/*
-
-=item C<void Parrot_pcc_invoke_from_sig_object>
-
-Follows the same conventions as C<Parrot_PCCINVOKE>, but the subroutine object
-to invoke is passed as an argument rather than looked up by name, and the
-signature string and call arguments are passed in a CallSignature PMC.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_pcc_invoke_from_sig_object(PARROT_INTERP, ARGIN(PMC *sub_obj),
- ARGIN(PMC *sig_obj))
-{
- ASSERT_ARGS(Parrot_pcc_invoke_from_sig_object)
-#define PCC_ARG_MAX 1024
- /* variables from PCCINVOKE impl in PCCMETHOD.pm */
- /* args INSP, returns INSP */
- INTVAL n_regs_used[] = { 0, 0, 0, 0, 0, 0, 0, 0 };
-
- /* Each of these is 8K. Do we want 16K on the stack? */
- opcode_t arg_indexes[PCC_ARG_MAX];
- opcode_t result_indexes[PCC_ARG_MAX];
-
- /* create the signature string, and the various PMCs that are needed to
- store all the parameters and parameter counts. */
- char * const signature = Parrot_str_to_cstring(interp, VTABLE_get_string(interp, sig_obj));
- PMC * const args_sig = temporary_pmc_new(interp, enum_class_FixedIntegerArray);
- PMC * const results_sig = temporary_pmc_new(interp, enum_class_FixedIntegerArray);
- PMC * const ret_cont = new_ret_continuation_pmc(interp, NULL);
- PMC * const result_list = VTABLE_get_attr_str(interp, sig_obj, CONST_STRING(interp, "returns"));
-
- Parrot_Context *ctx;
- opcode_t *dest;
- opcode_t *save_current_args;
- PMC *save_args_signature;
- PMC *save_current_object;
-
- /* temporary state vars for building PCC index and PCC signature arrays. */
-
- /* arg_indexes, result_indexes */
- opcode_t *indexes[2];
-
- /* args_sig, results_sig */
- PMC *sigs[2];
-
- const char *ret_x = NULL;
-
- indexes[0] = arg_indexes;
- indexes[1] = result_indexes;
- sigs[0] = args_sig;
- sigs[1] = results_sig;
-
- /* Count the number of objects of each type that need to be allocated by
- the caller to perform this function call */
- ctx = count_signature_elements(interp, signature, args_sig, results_sig, 0);
-
- /* code from PCCINVOKE impl in PCCMETHOD.pm */
- /* Save the current values of the interpreter arguments so that additional
- child sub calls don't kill our call stack. */
- save_current_args = interp->current_args;
- save_args_signature = interp->args_signature;
- save_current_object = interp->current_object;
-
- /* Set the function input parameters in the context structure, and return
- * the offset in the signature where the return params start. */
- ret_x = set_context_sig_params(interp, signature, n_regs_used,
- sigs, indexes, ctx, sig_obj);
-
- /* Set up the context object for the function invokation */
- interp->current_object = PMCNULL;
- interp->current_cont = NEED_CONTINUATION;
- ctx->current_cont = ret_cont;
- PMC_cont(ret_cont)->from_ctx = Parrot_context_ref(interp, ctx);
-
- /* Invoke the function */
- dest = VTABLE_invoke(interp, sub_obj, NULL);
-
- /* PIR Subs need runops to run their opcodes. Methods and NCI subs
- * don't. */
- if (sub_obj->vtable->base_type == enum_class_Sub
- && PMC_IS_NULL(interp->current_object)) {
- const INTVAL old_core = interp->run_core;
- const opcode_t offset = dest - interp->code->base.data;
-
- /* can't re-enter the runloop from here with PIC cores: RT #60048 */
- if (interp->run_core == PARROT_CGP_CORE
- || interp->run_core == PARROT_SWITCH_CORE)
- interp->run_core = PARROT_SLOW_CORE;
-
- runops(interp, offset);
- interp->run_core = old_core;
- }
-
- /* Set the return values from the subroutine's context into the
- caller's context */
- set_context_sig_returns(interp, ctx, indexes, ret_x, result_list);
-
- temporary_pmc_free(interp, args_sig);
- temporary_pmc_free(interp, results_sig);
-
- interp->current_args = save_current_args;
- interp->args_signature = save_args_signature;
- interp->current_object = save_current_object;
- Parrot_str_free_cstring(signature);
-}
-
-
-/*
-
-=back
-
-=head1 SEE ALSO
-
-F<include/parrot/interpreter.h>, F<src/inter_run.c>, F<src/pmc/sub.pmc>.
-
-=cut
-
-*/
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Deleted: trunk/src/inter_run.c
==============================================================================
--- trunk/src/inter_run.c Wed Feb 11 20:42:56 2009 (r36594)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,808 +0,0 @@
-/*
-Copyright (C) 2001-2008, The Perl Foundation.
-$Id$
-
-=head1 NAME
-
-src/inter_run.c - Parrot Interpreter - Run Ops and Methods
-
-=head1 DESCRIPTION
-
-Various functions that call the run loop.
-
-=head2 Functions
-
-=over 4
-
-=cut
-
-*/
-
-
-#include "parrot/parrot.h"
-#include "parrot/oplib/ops.h"
-
-/* HEADERIZER HFILE: include/parrot/interpreter.h */
-
-/* HEADERIZER BEGIN: static */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static Parrot_Context * runops_args(PARROT_INTERP,
- ARGIN(PMC *sub),
- ARGIN_NULLOK(PMC *obj),
- SHIM(STRING *meth),
- ARGIN(const char *sig),
- va_list ap)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(5);
-
-#define ASSERT_ARGS_runops_args __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(sub) \
- || PARROT_ASSERT_ARG(sig)
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: static */
-
-#define STACKED_EXCEPTIONS 1
-#define RUNLOOP_TRACE 0
-
-static int
-runloop_id_counter = 0; /* for synthesizing runloop ids. */
-
-/*
-
-=item C<void runops>
-
-Run parrot ops. Set exception handler and/or resume after exception.
-
-=cut
-
-*/
-
-void
-runops(PARROT_INTERP, size_t offs)
-{
- ASSERT_ARGS(runops)
- volatile size_t offset = offs;
- const int old_runloop_id = interp->current_runloop_id;
- const int our_runloop_level = ++interp->current_runloop_level;
- const int our_runloop_id = ++runloop_id_counter;
-
- /* It is OK if the runloop ID overflows; we only ever test it for equality,
- so the chance of collision is slight. */
- interp->current_runloop_id = our_runloop_id;
-
-#if RUNLOOP_TRACE
- fprintf(stderr, "[entering loop %d, level %d]\n",
- interp->current_runloop_id, our_runloop_level);
-#endif
-
- /*
- * STACKED_EXCEPTIONS are necessary to catch exceptions in reentered
- * run loops, e.g. if a delegate method throws an exception
- */
-#if ! STACKED_EXCEPTIONS
- if (!interp->current_runloop)
-#endif
- {
- new_runloop_jump_point(interp);
- if (setjmp(interp->current_runloop->resume)) {
- /* an exception was handled */
- if (STACKED_EXCEPTIONS)
- free_runloop_jump_point(interp);
-
- interp->current_runloop_level = our_runloop_level - 1;
- interp->current_runloop_id = old_runloop_id;
-
-#if RUNLOOP_TRACE
- fprintf(stderr, "[handled exception; back to loop %d, level %d]\n",
- interp->current_runloop_id, interp->current_runloop_level);
-#endif
- return;
- }
- }
-
- runops_int(interp, offset);
-
- /* Remove the current runloop marker (put it on the free list). */
- if (STACKED_EXCEPTIONS || interp->current_runloop)
- free_runloop_jump_point(interp);
-
-#if RUNLOOP_TRACE
- fprintf(stderr, "[exiting loop %d, level %d]\n",
- our_runloop_id, our_runloop_level);
-#endif
-
- interp->current_runloop_level = our_runloop_level - 1;
- interp->current_runloop_id = old_runloop_id;
-}
-
-/*
-
-=item C<Parrot_Context * Parrot_runops_fromc>
-
-Runs the Parrot ops, called from C code. The function arguments are
-already setup according to Parrot calling conventions, the C<sub> argument
-is an invocable C<Sub> PMC.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CANNOT_RETURN_NULL
-Parrot_Context *
-Parrot_runops_fromc(PARROT_INTERP, ARGIN(PMC *sub))
-{
- ASSERT_ARGS(Parrot_runops_fromc)
- opcode_t offset, *dest;
- Parrot_Context *ctx;
-
- /* we need one return continuation with a NULL offset */
- PMC * const ret_c = new_ret_continuation_pmc(interp, NULL);
- interp->current_cont = ret_c;
-#if defined GC_VERBOSE && GC_VERBOSE
- PObj_report_SET(ret_c); /* s. also src/gc/api.c */
-#endif
- /* invoke the sub, which places the context of the sub in the
- * interpreter, and switches code segments if needed
- * Passing a dummy true destination copies registers
- */
- dest = VTABLE_invoke(interp, sub, (void*) 1);
- if (!dest)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "Subroutine returned a NULL address");
-
- ctx = CONTEXT(interp);
- offset = dest - interp->code->base.data;
- runops(interp, offset);
- return ctx;
-}
-
-
-/*
-
-=item C<static Parrot_Context * runops_args>
-
-Calls the PMC subroutine C<sub> with optional name C<meth>. If PMC object
-C<obj> is provided, the call is treated as a method call on that object.
-The function has a function signature C<sig> and a variadic argument list
-C<ap>.
-
-Signatures are similar to NCI:
-
- v ... void return
- I ... INTVAL (not Interpreter)
- N ... NUMVAL
- S ... STRING*
- P ... PMC*
-
-TODO: Update this list of possible signature elements.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static Parrot_Context *
-runops_args(PARROT_INTERP, ARGIN(PMC *sub), ARGIN_NULLOK(PMC *obj),
- SHIM(STRING *meth), ARGIN(const char *sig), va_list ap)
-{
- ASSERT_ARGS(runops_args)
- opcode_t offset, *dest;
- Parrot_Context *ctx;
-
- char new_sig[10];
- const char *sig_p;
- Parrot_Context * const old_ctx = CONTEXT(interp);
-
- interp->current_cont = new_ret_continuation_pmc(interp, NULL);
- interp->current_object = obj;
- dest = VTABLE_invoke(interp, sub, NULL);
- if (!dest)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "Subroutine returned a NULL address");
-
- if (PMC_IS_NULL(obj)) {
- /* skip over the return type */
- sig_p = sig + 1;
- }
- else if (sig[1] == 'O') {
- /* skip over the return type */
- sig_p = sig + 1;
- }
- else {
- const size_t len = strlen(sig);
- if (len > 8)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "too many arguments in runops_args");
-
- new_sig[0] = 'O';
- /* -1 from the end, +1 for the nul at the end */
- memcpy(new_sig+1, sig+1, len);
- sig_p = new_sig;
- }
-
- if (*sig_p && (dest[0] == PARROT_OP_get_params_pc
- || (sub->vtable->base_type == enum_class_ExceptionHandler
- && PMC_cont(sub)->current_results))) {
- dest = parrot_pass_args_fromc(interp, sig_p, dest, old_ctx, ap);
- }
-
- /*
- * main is now started with runops_args_fromc too
- * PASM subs usually don't have get_params
- * XXX we could check, if we are running main
- else
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "no get_params in sub");
- */
-
- ctx = Parrot_context_ref(interp, CONTEXT(interp));
- offset = dest - interp->code->base.data;
- runops(interp, offset);
- return ctx;
-}
-
-
-/*
-
-=item C<void * Parrot_run_meth_fromc>
-
-Run a method sub from C. The function arguments are
-already setup according to Parrot calling conventions, the C<sub> argument
-is an invocable C<Sub> PMC.
-
-If a PMC return value is registered it is returned.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-void *
-Parrot_run_meth_fromc(PARROT_INTERP, ARGIN(PMC *sub), ARGIN_NULLOK(PMC *obj), SHIM(STRING *meth))
-{
- ASSERT_ARGS(Parrot_run_meth_fromc)
- Parrot_Context *ctx;
- opcode_t offset, *dest;
-
- interp->current_cont = new_ret_continuation_pmc(interp, NULL);
- interp->current_object = obj;
- dest = VTABLE_invoke(interp, sub, (void *)1);
-
- if (!dest)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "Subroutine returned a NULL address");
-
- ctx = CONTEXT(interp);
- offset = dest - interp->code->base.data;
- runops(interp, offset);
- return set_retval(interp, 0, ctx);
-}
-
-/*
-
-=item C<PMC * Parrot_runops_fromc_args>
-
-Run parrot ops, called from C code, function arguments are passed as
-C<va_args> according to the signature. The C<sub> argument is an
-invocable C<Sub> PMC.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-PMC *
-Parrot_runops_fromc_args(PARROT_INTERP, ARGIN(PMC *sub), ARGIN(const char *sig), ...)
-{
- ASSERT_ARGS(Parrot_runops_fromc_args)
- va_list args;
- Parrot_Context *ctx;
- PMC *retval;
-
- va_start(args, sig);
- ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
- va_end(args);
- retval = (PMC *)set_retval(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
- return retval;
-}
-
-/*
-
-=item C<void * Parrot_runops_fromc_args_event>
-
-Run code from within event handlers. This variant deals with some reentrency
-issues. It also should do sanity checks, if e.g. the handler subroutine
-didn't return properly.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-void *
-Parrot_runops_fromc_args_event(PARROT_INTERP, ARGIN(PMC *sub),
- ARGIN(const char *sig), ...)
-{
- ASSERT_ARGS(Parrot_runops_fromc_args_event)
- va_list args;
- Parrot_Context *ctx;
- void *retval;
- /*
- * running code from event handlers isn't fully reentrant due to
- * these interpreter variables - mainly related to calls
- */
- opcode_t * const cargs = interp->current_args;
- opcode_t * const params = interp->current_params;
- opcode_t * const returns = interp->current_returns;
- PMC * const cont = interp->current_cont;
- /* what else ? */
-
- va_start(args, sig);
- ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
- va_end(args);
- retval = set_retval(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
-
- interp->current_args = cargs;
- interp->current_params = params;
- interp->current_returns = returns;
- interp->current_cont = cont;
- return retval;
-}
-
-/*
-
-=item C<INTVAL Parrot_runops_fromc_args_reti>
-
-Called from C code, runs a Parrot subroutine C<sub>. The subroutine has
-function signature C<sig> and a C variadic argument list. Returns an
-C<INTVAL>.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-INTVAL
-Parrot_runops_fromc_args_reti(PARROT_INTERP, ARGIN(PMC *sub),
- ARGIN(const char *sig), ...)
-{
- ASSERT_ARGS(Parrot_runops_fromc_args_reti)
- va_list args;
- Parrot_Context *ctx;
- INTVAL retval;
-
- va_start(args, sig);
- ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
- va_end(args);
- retval = set_retval_i(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
- return retval;
-}
-
-/*
-
-=item C<FLOATVAL Parrot_runops_fromc_args_retf>
-
-Called from C code, runs a Parrot subroutine C<sub>. The subroutine has
-function signature C<sig> and a C variadic argument list. Returns a
-C<FLOATVAL>.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-FLOATVAL
-Parrot_runops_fromc_args_retf(PARROT_INTERP, ARGIN(PMC *sub),
- ARGIN(const char *sig), ...)
-{
- ASSERT_ARGS(Parrot_runops_fromc_args_retf)
- va_list args;
- Parrot_Context *ctx;
- FLOATVAL retval;
-
- va_start(args, sig);
- ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
- va_end(args);
- retval = set_retval_f(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
- return retval;
-}
-
-/*
-
-=item C<void* Parrot_run_meth_fromc_args>
-
-Called from C code, runs a Parrot subroutine C<sub> as a method on object
-C<obj>. The subroutine has function signature C<sig> and a C variadic argument
-list.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-void*
-Parrot_run_meth_fromc_args(PARROT_INTERP, ARGIN(PMC *sub), ARGIN_NULLOK(PMC *obj),
- ARGIN(STRING *meth), ARGIN(const char *sig), ...)
-{
- ASSERT_ARGS(Parrot_run_meth_fromc_args)
- va_list args;
- Parrot_Context *ctx;
- void* retval;
-
- va_start(args, sig);
- ctx = runops_args(interp, sub, obj, meth, sig, args);
- va_end(args);
- retval = set_retval(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
- return retval;
-}
-
-/*
-
-=item C<INTVAL Parrot_run_meth_fromc_args_reti>
-
-Called from C code, runs a Parrot subroutine C<sub> as a method on object
-C<obj>. The subroutine has function signature C<sig> and a C variadic argument
-list. Returns an C<INTVAL>.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-INTVAL
-Parrot_run_meth_fromc_args_reti(PARROT_INTERP, ARGIN(PMC *sub), ARGIN_NULLOK(PMC *obj),
- ARGIN(STRING *meth), ARGIN(const char *sig), ...)
-{
- ASSERT_ARGS(Parrot_run_meth_fromc_args_reti)
- va_list args;
- Parrot_Context *ctx;
- INTVAL retval;
-
- va_start(args, sig);
- ctx = runops_args(interp, sub, obj, meth, sig, args);
- va_end(args);
- retval = set_retval_i(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
- return retval;
-}
-
-/*
-
-=item C<FLOATVAL Parrot_run_meth_fromc_args_retf>
-
-Called from C code, runs a Parrot subroutine C<sub> as a method on object
-C<obj>. The subroutine has function signature C<sig> and a C variadic argument
-list C<args>. Returns a C<FLOATVAL>.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-FLOATVAL
-Parrot_run_meth_fromc_args_retf(PARROT_INTERP, ARGIN(PMC *sub), ARGIN_NULLOK(PMC *obj),
- ARGIN(STRING *meth), ARGIN(const char *sig), ...)
-{
- ASSERT_ARGS(Parrot_run_meth_fromc_args_retf)
- va_list args;
- Parrot_Context *ctx;
- FLOATVAL retval;
-
- va_start(args, sig);
- ctx = runops_args(interp, sub, obj, meth, sig, args);
- va_end(args);
- retval = set_retval_f(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
- return retval;
-}
-
-/*
-
-=item C<void * Parrot_runops_fromc_arglist>
-
-Called from C code, runs a Parrot subroutine C<sub>.
-The subroutine has function signature C<sig> and a C C<va_list>
-argument list C<args>.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-void *
-Parrot_runops_fromc_arglist(PARROT_INTERP, ARGIN(PMC *sub),
- ARGIN(const char *sig), va_list args)
-{
- ASSERT_ARGS(Parrot_runops_fromc_arglist)
- void* retval;
- Parrot_Context * const ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
-
- retval = set_retval(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
- return retval;
-}
-
-/*
-
-=item C<INTVAL Parrot_runops_fromc_arglist_reti>
-
-Called from C code, runs a Parrot subroutine C<sub>.
-The subroutine has function signature C<sig> and a C C<va_list>
-argument list C<args>. Returns an C<INTVAL>.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-INTVAL
-Parrot_runops_fromc_arglist_reti(PARROT_INTERP, ARGIN(PMC *sub),
- ARGIN(const char *sig), va_list args)
-{
- ASSERT_ARGS(Parrot_runops_fromc_arglist_reti)
- INTVAL retval;
- Parrot_Context * const ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
-
- retval = set_retval_i(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
- return retval;
-}
-
-/*
-
-=item C<FLOATVAL Parrot_runops_fromc_arglist_retf>
-
-Called from C code, runs a Parrot subroutine C<sub>.
-The subroutine has function signature C<sig> and a C C<va_list>
-argument list C<args>. Returns an C<FLOATVAL>.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-FLOATVAL
-Parrot_runops_fromc_arglist_retf(PARROT_INTERP, ARGIN(PMC *sub),
- ARGIN(const char *sig), va_list args)
-{
- ASSERT_ARGS(Parrot_runops_fromc_arglist_retf)
- FLOATVAL retval;
- Parrot_Context * const ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
-
- retval = set_retval_f(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
- return retval;
-}
-
-/*
-
-=item C<void* Parrot_run_meth_fromc_arglist>
-
-Calls the subroutine C<sub> as a method on object C<obj>. The method to be
-called is named C<meth>, has the function signature C<sig> and arguments
-C<args>. C<args> is a C variadic argument list created with C<va_start>.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-void*
-Parrot_run_meth_fromc_arglist(PARROT_INTERP, ARGIN(PMC *sub), ARGIN_NULLOK(PMC *obj),
- ARGIN(STRING *meth), ARGIN(const char *sig), va_list args)
-{
- ASSERT_ARGS(Parrot_run_meth_fromc_arglist)
- Parrot_Context *ctx;
- void* retval;
-
- ctx = runops_args(interp, sub, obj, meth, sig, args);
- retval = set_retval(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
- return retval;
-}
-
-/*
-
-=item C<INTVAL Parrot_run_meth_fromc_arglist_reti>
-
-Calls the subroutine C<sub> as a method on object C<obj>. The method to be
-called is named C<meth>, has the function signature C<sig> and arguments
-C<args>. C<args> is a C variadic argument list created with C<va_start>.
-Returns an C<INTVAL>.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-PARROT_CAN_RETURN_NULL
-INTVAL
-Parrot_run_meth_fromc_arglist_reti(PARROT_INTERP, ARGIN(PMC *sub), ARGIN_NULLOK(PMC *obj),
- ARGIN(STRING *meth), ARGIN(const char *sig), va_list args)
-{
- ASSERT_ARGS(Parrot_run_meth_fromc_arglist_reti)
- INTVAL retval;
- Parrot_Context * const ctx = runops_args(interp, sub, obj, meth, sig, args);
-
- retval = set_retval_i(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
- return retval;
-}
-
-/*
-
-=item C<FLOATVAL Parrot_run_meth_fromc_arglist_retf>
-
-Calls the subroutine C<sub> as a method on object C<obj>. The method to be
-called is named C<meth>, has the function signature C<sig> and arguments
-C<args>. C<args> is a C variadic argument list created with C<va_start>.
-Returns a C<FLOATVAL>.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_IGNORABLE_RESULT
-FLOATVAL
-Parrot_run_meth_fromc_arglist_retf(PARROT_INTERP, ARGIN(PMC *sub), ARGIN_NULLOK(PMC *obj),
- ARGIN(STRING *meth), ARGIN(const char *sig), va_list args)
-{
- ASSERT_ARGS(Parrot_run_meth_fromc_arglist_retf)
- FLOATVAL retval;
- Parrot_Context * const ctx = runops_args(interp, sub, obj, meth, sig, args);
-
- retval = set_retval_f(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
- return retval;
-}
-
-/*
-
-=back
-
-=head2 Helper Functions
-
-=over 4
-
-=item C<void new_runloop_jump_point>
-
-Create a new runloop jump point, either by allocating it or by
-getting one from the free list.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-new_runloop_jump_point(PARROT_INTERP)
-{
- ASSERT_ARGS(new_runloop_jump_point)
- Parrot_runloop *jump_point;
-
- if (interp->runloop_jmp_free_list) {
- jump_point = interp->runloop_jmp_free_list;
- interp->runloop_jmp_free_list = jump_point->prev;
- }
- else
- jump_point = mem_allocate_typed(Parrot_runloop);
-
- jump_point->prev = interp->current_runloop;
- interp->current_runloop = jump_point;
-}
-
-/*
-
-=item C<void free_runloop_jump_point>
-
-Place runloop jump point back on the free list.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-free_runloop_jump_point(PARROT_INTERP)
-{
- ASSERT_ARGS(free_runloop_jump_point)
- Parrot_runloop * const jump_point = interp->current_runloop;
- interp->current_runloop = jump_point->prev;
- jump_point->prev = interp->runloop_jmp_free_list;
- interp->runloop_jmp_free_list = jump_point;
-}
-
-/*
-
-=item C<void destroy_runloop_jump_points>
-
-Destroys (and frees the memory of) the runloop jump point list and the
-associated free list for the specified interpreter.
-
-=cut
-
-*/
-
-void
-destroy_runloop_jump_points(PARROT_INTERP)
-{
- ASSERT_ARGS(destroy_runloop_jump_points)
- really_destroy_runloop_jump_points(interp->current_runloop);
- really_destroy_runloop_jump_points(interp->runloop_jmp_free_list);
-}
-
-/*
-
-=item C<void really_destroy_runloop_jump_points>
-
-Takes a pointer to a runloop jump point (which had better be the last one in
-the list). Walks back through the list, freeing the memory of each one, until
-it encounters NULL. Used by C<destroy_runloop_jump_points>.
-
-=cut
-
-*/
-
-void
-really_destroy_runloop_jump_points(ARGIN_NULLOK(Parrot_runloop *jump_point))
-{
- ASSERT_ARGS(really_destroy_runloop_jump_points)
- while (jump_point) {
- Parrot_runloop * const prev = jump_point->prev;
- mem_sys_free(jump_point);
- jump_point = prev;
- }
-}
-
-
-/*
-
-=back
-
-=head1 SEE ALSO
-
-F<include/parrot/interpreter.h>, F<src/interpreter.c>.
-
-=cut
-
-*/
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Modified: trunk/src/multidispatch.c
==============================================================================
--- trunk/src/multidispatch.c Wed Feb 11 20:23:35 2009 (r36594)
+++ trunk/src/multidispatch.c Wed Feb 11 20:42:56 2009 (r36595)
@@ -280,125 +280,6 @@
return Parrot_mmd_sort_manhattan_by_sig_pmc(interp, candidate_list, invoke_sig);
}
-
-/*
-
-=item C<PMC* Parrot_build_sig_object_from_varargs>
-
-Take a varargs list, and convert it into a CallSignature PMC. The CallSignature
-stores the original short signature string, and an array of integer types to
-pass on to the multiple dispatch search.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-PMC*
-Parrot_build_sig_object_from_varargs(PARROT_INTERP, ARGIN_NULLOK(PMC* obj),
- ARGIN(const char *sig), va_list args)
-{
- ASSERT_ARGS(Parrot_build_sig_object_from_varargs)
- PMC *type_tuple = PMCNULL;
- PMC *returns = PMCNULL;
- PMC *call_object = pmc_new(interp, enum_class_CallSignature);
- STRING *string_sig = Parrot_str_new_constant(interp, sig);
- const INTVAL sig_len = Parrot_str_byte_length(interp, string_sig);
- INTVAL in_return_sig = 0;
- INTVAL i;
-
- if (!sig_len)
- return call_object;
-
- VTABLE_set_string_native(interp, call_object, string_sig);
-
- /* Process the varargs list */
- for (i = 0; i < sig_len; ++i) {
- const INTVAL type = Parrot_str_indexed(interp, string_sig, i);
-
- /* Only create the returns array if it's needed */
- if (in_return_sig && PMC_IS_NULL(returns)) {
- returns = pmc_new(interp, enum_class_ResizablePMCArray);
- VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "results"), returns);
- }
-
- if (in_return_sig) {
- STRING * const signature = CONST_STRING(interp, "signature");
- /* Returns store the original passed-in pointer, so they can pass
- * the result back to the caller. */
- PMC * const val_pointer = pmc_new(interp, enum_class_CPointer);
- VTABLE_push_pmc(interp, returns, val_pointer);
-
- switch (type) {
- case 'I':
- VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, INTVAL *));
- VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "I"));
- break;
- case 'N':
- VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, FLOATVAL *));
- VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "N"));
- break;
- case 'S':
- VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, STRING **));
- VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "S"));
- break;
- case 'P':
- VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, PMC **));
- VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "P"));
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "Multiple Dispatch: invalid argument type %c!", type);
- }
- }
- else {
- /* Regular arguments just set the value */
- switch (type) {
- case 'I':
- VTABLE_push_integer(interp, call_object, va_arg(args, INTVAL));
- break;
- case 'N':
- VTABLE_push_float(interp, call_object, va_arg(args, FLOATVAL));
- break;
- case 'S':
- VTABLE_push_string(interp, call_object, va_arg(args, STRING *));
- break;
- case 'P':
- {
- PMC * const pmc_arg = va_arg(args, PMC *);
- VTABLE_push_pmc(interp, call_object, pmc_arg);
- break;
- }
- case '-':
- i++; /* skip '>' */
- in_return_sig = 1;
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "Multiple Dispatch: invalid argument type %c!", type);
- }
- }
- }
-
- /* Check if we have an invocant, and add it to the front of the arguments */
- if (!PMC_IS_NULL(obj)) {
- string_sig = Parrot_str_concat(interp, CONST_STRING(interp, "Pi"), string_sig, 0);
- VTABLE_set_string_native(interp, call_object, string_sig);
- VTABLE_unshift_pmc(interp, call_object, obj);
- }
-
- /* Build a type_tuple for multiple dispatch */
- type_tuple = Parrot_mmd_build_type_tuple_from_sig_obj(interp, call_object);
- VTABLE_set_pmc(interp, call_object, type_tuple);
-
- return call_object;
-}
-
-
/*
=item C<void Parrot_mmd_multi_dispatch_from_c_args>
@@ -425,7 +306,7 @@
va_list args;
va_start(args, sig);
- sig_object = Parrot_build_sig_object_from_varargs(interp, PMCNULL, sig, args);
+ sig_object = Parrot_pcc_build_sig_object_from_varargs(interp, PMCNULL, sig, args);
va_end(args);
/* Check the cache. */
More information about the parrot-commits
mailing list