[svn:parrot] r41670 - in branches/pcc_reapply: include/parrot src/call
bacek at svn.parrot.org
bacek at svn.parrot.org
Sun Oct 4 02:09:55 UTC 2009
Author: bacek
Date: Sun Oct 4 02:09:53 2009
New Revision: 41670
URL: https://trac.parrot.org/parrot/changeset/41670
Log:
Old PCC is dead-dead-dead. Remove last functions.
Modified:
branches/pcc_reapply/include/parrot/call.h
branches/pcc_reapply/src/call/pcc.c
Modified: branches/pcc_reapply/include/parrot/call.h
==============================================================================
--- branches/pcc_reapply/include/parrot/call.h Sun Oct 4 02:09:33 2009 (r41669)
+++ branches/pcc_reapply/include/parrot/call.h Sun Oct 4 02:09:53 2009 (r41670)
@@ -145,71 +145,6 @@
/* 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(PMC *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
-int Parrot_init_arg_op(PARROT_INTERP,
- ARGIN(PMC *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(PMC *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_pass_args(PARROT_INTERP,
- ARGMOD(PMC *src_ctx),
- ARGMOD(PMC *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 *call_object))
@@ -250,85 +185,6 @@
__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(PARROT_INTERP, ARGIN(const call_state *st))
- __attribute__nonnull__(1)
- __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(PMC *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(PMC *ctx))
- __attribute__nonnull__(1)
- __attribute__nonnull__(3);
-
-FLOATVAL set_retval_f(PARROT_INTERP, int sig_ret, ARGIN(PMC *ctx))
- __attribute__nonnull__(1)
- __attribute__nonnull__(3);
-
-INTVAL set_retval_i(PARROT_INTERP, int sig_ret, ARGIN(PMC *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(PMC *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(PMC *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_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_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) \
@@ -350,32 +206,6 @@
, 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(interp) \
- , 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/call/pcc.c */
Modified: branches/pcc_reapply/src/call/pcc.c
==============================================================================
--- branches/pcc_reapply/src/call/pcc.c Sun Oct 4 02:09:33 2009 (r41669)
+++ branches/pcc_reapply/src/call/pcc.c Sun Oct 4 02:09:53 2009 (r41670)
@@ -29,245 +29,6 @@
/* 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(PMC *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(PMC *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);
-
-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);
-
-static void set_context_sig_returns(PARROT_INTERP,
- ARGMOD(PMC *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 int set_retval_util(PARROT_INTERP,
- ARGIN(const char *sig),
- ARGIN(PMC *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(PARROT_INTERP,
- ARGIN(const call_state *st),
- INTVAL idx)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-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_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_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_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(interp) \
- , 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 */
@@ -275,1848 +36,6 @@
/* Make sure we don't conflict with any other MAX() macros defined elsewhere */
#define PARROT_MAX(a, b) (((a)) > (b) ? (a) : (b))
-
-/*
-
-=item C<int Parrot_init_arg_indexes_and_sig_pmc(PARROT_INTERP, PMC *ctx,
-opcode_t *indexes, PMC *sig_pmc, call_state_item *sti)>
-
-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(PMC *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 (PMC_IS_NULL(sig_pmc) && indexes) {
- ++indexes;
- sig_pmc = Parrot_pcc_get_pmc_constant(interp, ctx, *indexes);
- 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(PARROT_INTERP, PMC *ctx, opcode_t *pc,
-call_state_item *sti)>
-
-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(PMC *ctx),
- ARGIN_NULLOK(opcode_t *pc), ARGIN(call_state_item *sti))
-{
- ASSERT_ARGS(Parrot_init_arg_op)
- PMC *sig_pmc = PMCNULL;
-
- if (pc) {
- if (*pc == 0)
- return 0;
- ++pc;
- sig_pmc = Parrot_pcc_get_pmc_constant(interp, ctx, *pc);
- 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(PARROT_INTERP, PMC *ctx, const char *sig, void
-*ap, call_state_item *sti)>
-
-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(PMC *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(PARROT_INTERP, call_state *st, PMC *p_arg)>
-
-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);
- VTABLE_set_integer_native(interp, st->key, 0);
- SETATTR_Key_next_key(interp, st->key, (PMC *)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(PARROT_INTERP, call_state_item *sti)>
-
-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(PARROT_INTERP, call_state *st)>
-
-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) = Parrot_pcc_get_object(interp, CURRENT_CONTEXT(interp));
- 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(PARROT_INTERP, call_state *st)>
-
-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,
- Parrot_pcc_get_string_constant(interp, st->src.ctx, idx));
- else
- UVal_str(st->val) = CTX_REG_STR(st->src.ctx, idx);
-
- break;
- }
- case PARROT_ARG_FLOATVAL:
- UVal_num(st->val) = constant
- ? Parrot_pcc_get_num_constant(interp, st->src.ctx, idx)
- : CTX_REG_NUM(st->src.ctx, idx);
- break;
- case PARROT_ARG_PMC:
- UVal_pmc(st->val) = constant
- ? Parrot_pcc_get_pmc_constant(interp, st->src.ctx, idx)
- : 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(PARROT_INTERP, call_state *st)>
-
-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 *)VTABLE_get_pointer(interp, 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(PARROT_INTERP, call_state *st)>
-
-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 * const 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(PARROT_INTERP, call_state *st)>
-
-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(PARROT_INTERP, call_state *st)>
-
-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(PARROT_INTERP, call_state *st)>
-
-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(PARROT_INTERP, call_state *st)>
-
-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(PARROT_INTERP, call_state *st, int
-has_arg)>
-
-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(PARROT_INTERP, call_state *st)>
-
-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 = VTABLE_shift_pmc(interp, key)) {
- /* register keys have to be cloned */
- if (PObj_get_FLAGS(key) & KEY_register_FLAG) {
- INTVAL n_regs_used[4];
- Regs_ni bp;
- Regs_ps bp_ps;
-
- /* clone sets key values according to refered register items */
- bp = *Parrot_pcc_get_regs_ni(interp, CURRENT_CONTEXT(interp));
- bp_ps = *Parrot_pcc_get_regs_ps(interp, CURRENT_CONTEXT(interp));
- memcpy(n_regs_used, CONTEXT(interp)->n_regs_used, 4 * sizeof (INTVAL));
-
- Parrot_pcc_set_regs_ni(interp, CURRENT_CONTEXT(interp),
- Parrot_pcc_get_regs_ni(interp, st->src.ctx));
- Parrot_pcc_set_regs_ps(interp, CURRENT_CONTEXT(interp),
- Parrot_pcc_get_regs_ps(interp, st->src.ctx));
- memcpy(CONTEXT(interp)->n_regs_used,
- Parrot_pcc_get_context_struct(interp, st->src.ctx),
- 4 * sizeof (INTVAL));
-
- UVal_pmc(st->val) = VTABLE_clone(interp, key);
-
- Parrot_pcc_set_regs_ni(interp, CURRENT_CONTEXT(interp), &bp);
- Parrot_pcc_set_regs_ps(interp, CURRENT_CONTEXT(interp), &bp_ps);
- memcpy(CONTEXT(interp)->n_regs_used, n_regs_used, 4 * sizeof (INTVAL));
-
- return;
- }
- }
-}
-
-
-/*
-
-=item C<static void init_first_dest_named(PARROT_INTERP, call_state *st)>
-
-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 */
- 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(PARROT_INTERP, call_state *st)>
-
-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)
- ? Parrot_pcc_get_string_constant(interp, st->dest.ctx, idx)
- : CTX_REG_STR(st->dest.ctx, idx);
-
- if (st->name == param || Parrot_str_equal(interp, st->name, param)) {
- ++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(PARROT_INTERP, const call_state *st, INTVAL idx)>
-
-Stores the next argument in the destination register appropriately.
-
-=cut
-
-*/
-
-static void
-store_arg(PARROT_INTERP, 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(PARROT_INTERP, const call_state *st)>
-
-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(PARROT_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(interp, st, idx);
-
- return 1;
-}
-
-
-/*
-
-=item C<static void too_few(PARROT_INTERP, const call_state *st, const char
-*action)>
-
-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%s expected",
- st->n_actual_args,
- (min_expected_args < max_expected_args ? "at least " : ""),
- min_expected_args, action,
- (min_expected_args == 1 ? "" : "s"));
- }
-}
-
-
-/*
-
-=item C<static void too_many(PARROT_INTERP, const call_state *st, const char
-*action)>
-
-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%s expected",
- st->n_actual_args,
- (min_expected_args < max_expected_args ? "at most " : ""),
- max_expected_args, action,
- (max_expected_args == 1 ? "" : "s"));
- }
-}
-
-
-/*
-
-=item C<static void null_val(int sig, call_state *st)>
-
-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(PARROT_INTERP, call_state *st)>
-
-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) {
- int last_name_pos = i;
- INTVAL arg_sig;
-
- /* if slurpy then no errors, return */
- if (sig & PARROT_ARG_SLURPY_ARRAY)
- return;
-
- n_named++;
-
- /* 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(interp, 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)
- ? Parrot_pcc_get_string_constant(interp, st->dest.ctx, idx)
- : 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(call_state *st)>
-
-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(PARROT_INTERP, call_state *st, arg_pass_t
-param_or_result)>
-
-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)
- ? "result" : "param";
-
- /* 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
- */
- const UnionCallStateVal 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(interp, 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(interp, 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(PARROT_INTERP, call_state *st)>
-
-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(PARROT_INTERP, PMC *src_ctx, PMC *dest_ctx,
-opcode_t *src_indexes, opcode_t *dest_indexes, arg_pass_t param_or_result)>
-
-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> points 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(PMC *src_ctx), ARGMOD(PMC *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)
- PMC *src_signature, *dest_signature;
- call_state st;
-
- 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 = Parrot_pcc_get_results_signature(interp, dest_ctx);
- interp->returns_signature = NULL;
- Parrot_pcc_set_results_signature(interp, dest_ctx, NULL);
- }
-
- memset(&st, 0, sizeof st);
-
- 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);
-}
-
-
-/*
-
-=item C<opcode_t * parrot_pass_args_fromc(PARROT_INTERP, const char *sig,
-opcode_t *dest, PMC *old_ctxp, va_list ap)>
-
-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(PMC *old_ctxp), va_list ap)
-{
- ASSERT_ARGS(parrot_pass_args_fromc)
- call_state st;
-
- Parrot_init_arg_op(interp, CURRENT_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(PARROT_INTERP, const char *sig, PMC *ctx,
-call_state *st)>
-
-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(PMC *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, CURRENT_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(PARROT_INTERP, int sig_ret, PMC *ctx)>
-
-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(PMC *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(PARROT_INTERP, int sig_ret, PMC *ctx)>
-
-Handles an INTVAL return value, returning its value if present and 0 otherwise.
-
-=cut
-
-*/
-
-INTVAL
-set_retval_i(PARROT_INTERP, int sig_ret, ARGIN(PMC *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(PARROT_INTERP, int sig_ret, PMC *ctx)>
-
-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(PMC *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(PARROT_INTERP, int sig_ret, PMC *ctx)>
-
-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(PMC *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(PARROT_INTERP, int sig_ret, PMC *ctx)>
-
-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(PMC *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(PARROT_INTERP, int index, int cur, opcode_t
-*n_regs_used, int seen_arrow, PMC * const *sigs, opcode_t **indexes, PMC *ctx,
-PMC *pmc, va_list *list)>
-
-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(PMC *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 void commit_last_arg_sig_object(PARROT_INTERP, int index, int
-cur, opcode_t *n_regs_used, int seen_arrow, PMC * const *sigs, opcode_t
-**indexes, PMC *ctx, PMC *sig_obj)>
-
-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(PMC *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(PARROT_INTERP, PMC *ctx, opcode_t
-**indexes, const char *ret_x, PMC *result_list)>
-
-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(PMC *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 * const 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 * const 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<void Parrot_pcc_invoke_sub_from_c_args(PARROT_INTERP, PMC *sub_obj,
More information about the parrot-commits
mailing list