Author: mdiep
Date: Mon Apr 23 18:39:22 2007
New Revision: 18311
Modified:
trunk/include/parrot/inter_call.h
trunk/src/inter_call.c
trunk/t/op/calling.t
trunk/t/op/cc_state.t
trunk/t/pmc/mmd.t
trunk/tools/build/nativecall.pl
Log:
[core]:
Rework Parrot_process_args (arg handling code).
This fixes #40490: Flat/Slurpy Named Parameter Passing Errors.
Modified: trunk/include/parrot/inter_call.h
==============================================================================
--- trunk/include/parrot/inter_call.h (original)
+++ trunk/include/parrot/inter_call.h Mon Apr 23 18:39:22 2007
@@ -6,9 +6,11 @@
* Data Structure and Algorithms:
* Call argument handling.
* History:
- * Initial version by leo on on 2005/07/22
+ * Initial version by leo on 2005/07/22
+ * Major changes by mdiep in April 2007
* Notes:
* References:
+ * pdd03 - Calling Conventions
*/
#if !defined(PARROT_INTER_CALL_H_GUARD)
@@ -17,61 +19,15 @@
enum call_state_mode {
/* arg processing states
* <src>_<dest> sd nibbles */
- CALL_STATE_POS_POS = 0x00,
- CALL_STATE_OPT = 0x01, /* dest only */
- CALL_STATE_SLURP = 0x02, /* dest only */
- CALL_STATE_NAMED_x = 0x40,
- CALL_STATE_END_x = 0x80,
- CALL_STATE_x_NAMED = 0x04,
- CALL_STATE_x_END = 0x08,
- CALL_STATE_POS_POS_OPT = CALL_STATE_OPT,
- CALL_STATE_POS_POS_SLURP = CALL_STATE_SLURP,
- CALL_STATE_POS_NAMED = CALL_STATE_x_NAMED,
- CALL_STATE_POS_NAMED_OPT = CALL_STATE_POS_NAMED|CALL_STATE_OPT,
- CALL_STATE_POS_END = CALL_STATE_x_END,
- CALL_STATE_NAMED_POS = CALL_STATE_NAMED_x,
- CALL_STATE_NAMED_POS_OPT = CALL_STATE_NAMED_x|CALL_STATE_OPT,
- CALL_STATE_NAMED_POS_SLURP = CALL_STATE_NAMED_x|CALL_STATE_SLURP,
- CALL_STATE_NAMED_NAMED = CALL_STATE_NAMED_x|CALL_STATE_x_NAMED,
- CALL_STATE_NAMED_NAMED_OPT = CALL_STATE_NAMED_NAMED|CALL_STATE_OPT,
- CALL_STATE_NAMED_NAMED_SLURP= CALL_STATE_NAMED_NAMED|CALL_STATE_SLURP,
- CALL_STATE_END_POS_OPT = CALL_STATE_END_x|CALL_STATE_OPT,
- CALL_STATE_END_NAMED_NAMED = CALL_STATE_END_x|CALL_STATE_NAMED_NAMED,
- CALL_STATE_END_POS_NAMED = CALL_STATE_END_x|CALL_STATE_POS_NAMED,
- CALL_STATE_END_NAMED_OPT = CALL_STATE_END_x|CALL_STATE_POS_NAMED_OPT,
- CALL_STATE_END_END = CALL_STATE_END_x|CALL_STATE_x_END,
- CALL_STATE_MASK = 0xff,
CALL_STATE_SIG = 0x100, /* runops, nci */
CALL_STATE_OP = 0x200, /* get_, set_ ops */
CALL_S_D_MASK = 0x300, /* src/dest mask */
- CALL_STATE_FLATTEN = 0x400, /* flatten src */
- CALL_STATE_NEXT_ARG = 0x800
+ CALL_STATE_FLATTEN = 0x400 /* flatten src */
};
-#define CALL_STATE_x_ISSET(o, x) (o & CALL_STATE_ ## x)
-#define CALL_STATE_x_SET(o, x) (o |= CALL_STATE_ ## x)
-#define CALL_STATE_x_UNSET(o, x) (o &= ~CALL_STATE_ ## x)
-
-#define CALL_STATE_MASK_MASK(o) (CALL_STATE_X_ISSET(o, MASK))
-#define CALL_STATE_SIG_ISSET(o) (CALL_STATE_X_ISSET(o, SIG))
-#define CALL_STATE_OP_ISSET(o) (CALL_STATE_X_ISSET(o, OP))
-#define CALL_S_D_MASK_MASK(o) (o & CALL_S_D_MASK)
-#define CALL_STATE_FLATTEN_ISSET(o) (CALL_STATE_X_ISSET(o, FLATTEN))
-#define CALL_STATE_NEXT_ARG_ISSET(o) (CALL_STATE_X_ISSET(o, NEXT_ARG))
-
-#define CALL_STATE_SIG_SET(o) (CALL_STATE_X_SET(o, SIG))
-#define CALL_STATE_OP_SET(o) (CALL_STATE_X_SET(o, OP))
-#define CALL_STATE_FLATTEN_SET(o) (CALL_STATE_X_SET(o, FLATTEN))
-#define CALL_STATE_NEXT_ARG_SET(o) (CALL_STATE_X_SET(o, NEXT_ARG))
-
-#define CALL_STATE_SIG_UNSET(o) (CALL_STATE_X_UNSET(o, SIG))
-#define CALL_STATE_OP_UNSET(o) (CALL_STATE_X_UNSET(o, OP))
-#define CALL_STATE_FLATTEN_UNSET(o) (CALL_STATE_X_UNSET(o, FLATTEN))
-#define CALL_STATE_NEXT_ARG_UNSET(o) (CALL_STATE_X_UNSET(o, NEXT_ARG))
-
typedef struct call_state_item {
int mode; /* from_sig, from_set_ops, flatten ...*/
union {
@@ -85,6 +41,7 @@
} op;
} u;
parrot_context_t *ctx;
+ INTVAL used;
INTVAL i;
INTVAL n;
INTVAL sig;
Modified: trunk/src/inter_call.c
==============================================================================
--- trunk/src/inter_call.c (original)
+++ trunk/src/inter_call.c Mon Apr 23 18:39:22 2007
@@ -41,6 +41,7 @@
static void next_arg_sig(Interp *interp, call_state_item *st);
static int set_retval_util(Parrot_Interp interp, const char *sig,
parrot_context_t *ctx, call_state *st);
+static void check_for_opt_flag(Interp *interp, call_state *st, int has_arg);
/*
@@ -127,6 +128,7 @@
++indexes;
}
+ st->used = 1;
st->i = 0;
st->n = 0;
st->mode = CALL_STATE_OP;
@@ -164,6 +166,7 @@
Parrot_init_arg_sig(Interp *interp, parrot_context_t *ctx, const char *sig,
void *ap, call_state_item *st)
{
+ st->used = 1;
st->i = 0;
st->n = 0;
st->mode = CALL_STATE_SIG;
@@ -211,7 +214,6 @@
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;
- Parrot_fetch_arg(interp, st);
}
@@ -250,12 +252,11 @@
st->sig = 0;
return 0;
}
- st->mode &= ~CALL_STATE_NEXT_ARG;
next_arg_sig(interp, st);
return 1;
}
-static void
+static int
fetch_arg_sig(Interp *interp, call_state *st)
{
va_list *ap = (va_list*)(st->src.u.sig.ap);
@@ -277,15 +278,22 @@
if (st->src.sig & PARROT_ARG_FLATTEN) {
start_flatten(interp, st, UVal_pmc(st->val));
- return;
+ /* 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;
+ return Parrot_fetch_arg(interp, st);
}
break;
}
- st->src.mode |= CALL_STATE_NEXT_ARG;
+ st->src.i++;
+ return 1;
}
-static void
+static int
fetch_arg_op(Interp *interp, call_state *st)
{
int constant = PARROT_ARG_CONSTANT_ISSET(st->src.sig);
@@ -297,118 +305,111 @@
break;
case PARROT_ARG_STRING:
UVal_str(st->val) = constant ?
st->src.ctx->constants[idx]->u.string
- : CTX_REG_STR(st->src.ctx, idx);
+ : 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);
+ : 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);
+ : CTX_REG_PMC(st->src.ctx, idx);
if (st->src.sig & PARROT_ARG_FLATTEN) {
start_flatten(interp, st, UVal_pmc(st->val));
- return;
+ /* 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;
+ return Parrot_fetch_arg(interp, st);
}
break;
}
- st->src.mode |= CALL_STATE_NEXT_ARG;
+ st->src.i++;
+ return 1;
}
int
Parrot_fetch_arg(Interp *interp, call_state *st)
{
- if (st->dest.mode & CALL_STATE_NEXT_ARG) {
- if (!next_arg(interp, &st->dest))
- st->dest.mode |= CALL_STATE_x_END;
- }
- if (!st->src.n) {
- st->dest.mode |= CALL_STATE_END_x;
+ if (!st->src.used)
+ return 1;
+ if (st->src.i >= st->src.n)
return 0;
- }
- if (st->src.mode & CALL_STATE_NEXT_ARG) {
- if (!next_arg(interp, &st->src)) {
- st->dest.mode |= CALL_STATE_END_x;
- return 0;
- }
- }
-#if 0
- /* NOT YET
- * e.g.
- * $ make
- * ../../parrot pgc.pir --output=PGE/builtins_gen.pir PGE/builtins.pg
- * positional inside named args
- * ...
- */
+ st->src.used = 0;
- if ((st->dest.mode & CALL_STATE_NAMED_x) && !(st->src.sig &
PARROT_ARG_NAME))
- real_exception(interp, NULL, E_ValueError, "positional inside named
args");
-#endif
+ next_arg_sig(interp, &st->src);
+ /* check if we're at a :flat argument */
if (st->src.mode & CALL_STATE_FLATTEN) {
- if (st->src.slurp_i < st->src.slurp_n) {
- PMC *elem;
- if (st->key) {
- st->src.slurp_i++;
- st->name = (STRING *)parrot_hash_get_idx(interp,
- (Hash *)PMC_struct_val(st->src.slurp), st->key);
- assert(st->name);
- elem = VTABLE_get_pmc_keyed_str(interp, st->src.slurp,
st->name);
- }
- else {
- elem = VTABLE_get_pmc_keyed_int(interp, st->src.slurp,
st->src.slurp_i++);
- }
- st->src.sig = PARROT_ARG_PMC;
- UVal_pmc(st->val) = elem;
- return 1;
+ PMC *elem;
+ assert(st->src.slurp_i < st->src.slurp_n);
+ if (st->key) {
+ st->src.slurp_i++;
+ st->name = (STRING *)parrot_hash_get_idx(interp,
+ (Hash *)PMC_struct_val(st->src.slurp), st->key);
+ assert(st->name);
+ elem = VTABLE_get_pmc_keyed_str(interp, st->src.slurp, st->name);
}
+ else {
+ elem = VTABLE_get_pmc_keyed_int(interp, st->src.slurp,
st->src.slurp_i++);
+ }
+ st->src.sig = PARROT_ARG_PMC;
+ UVal_pmc(st->val) = elem;
+
/* done with flattening */
- st->src.mode &= ~CALL_STATE_FLATTEN;
- st->src.mode |= CALL_STATE_NEXT_ARG;
- st->key = NULL;
- /* advance src - get next arg */
- return Parrot_fetch_arg(interp, st);
+ if (st->src.slurp_i == st->src.slurp_n) {
+ st->src.mode &= ~CALL_STATE_FLATTEN;
+ st->key = NULL;
+ 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(interp, &st->src);
+ next_arg_sig(interp, &st->src);
}
switch (st->src.mode & CALL_S_D_MASK) {
case CALL_STATE_OP:
- fetch_arg_op(interp, st);
- break;
+ return fetch_arg_op(interp, st);
case CALL_STATE_SIG:
- fetch_arg_sig(interp, st);
- break;
+ return fetch_arg_sig(interp, st);
}
- return 1;
+
+ internal_exception(1, "invalid call state mode");
+ return 0;
}
int
Parrot_fetch_arg_nci(Interp *interp, call_state *st)
{
- Parrot_fetch_arg(interp, st);
+ next_arg_sig(interp, &st->dest);
if (st->dest.sig & PARROT_ARG_SLURPY_ARRAY) {
PMC *slurped;
assert((st->dest.sig & PARROT_ARG_TYPE_MASK) == PARROT_ARG_PMC);
slurped = pmc_new(interp, enum_class_ResizablePMCArray);
- while (!(st->dest.mode & CALL_STATE_END_x)) {
+ while (Parrot_fetch_arg(interp, st)) {
+ st->src.used = 1;
Parrot_convert_arg(interp, st);
- st->dest.mode |= CALL_STATE_SLURP;
VTABLE_push_pmc(interp, slurped, UVal_pmc(st->val));
- Parrot_fetch_arg(interp, st);
}
UVal_pmc(st->val) = slurped;
}
else {
+ Parrot_fetch_arg(interp, st);
+ st->src.used = 1;
Parrot_convert_arg(interp, st);
- st->dest.mode |= CALL_STATE_NEXT_ARG;
}
+ st->dest.i++;
return 1;
}
@@ -488,6 +489,34 @@
}
}
+static void
+check_for_opt_flag(Interp *interp, call_state *st, int has_arg)
+{
+ INTVAL idx;
+ call_state_item *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;
+ assert(idx >= 0);
+ CTX_REG_INT(st->dest.ctx, idx) = has_arg;
+}
+
/*
* replace any src register by their values (done inside clone)
* need a test for tailcalls too, but I think there is no syntax
@@ -531,9 +560,7 @@
/* 1) if we were slurpying positional args, we are done, turn it off
* 2) set destination named args bit */
- st->dest.mode &= ~CALL_STATE_SLURP;
st->dest.slurp = NULL;
- st->dest.mode |= CALL_STATE_x_NAMED;
/* 1) count named args, make sure there is less than 32/64
* 2) create slurpy hash if needed */
@@ -575,8 +602,6 @@
INTVAL sig;
n_named = -1;
- st->dest.mode &= ~CALL_STATE_SLURP;
- st->dest.mode |= CALL_STATE_x_NAMED;
for (i = st->first_named; i < st->dest.n; ++i) {
sig = SIG_ITEM(st->dest.u.op.signature, i);
if (!(sig & PARROT_ARG_NAME))
@@ -592,7 +617,6 @@
st->named_done |= 1 << n_named;
return 1;
}
- st->dest.mode |= CALL_STATE_x_END;
return 0;
}
@@ -603,23 +627,18 @@
locate_named_named(Interp *interp, call_state *st)
{
int i, n_named, idx;
- INTVAL sig;
STRING *param;
n_named = -1;
- st->dest.mode &= ~CALL_STATE_SLURP;
- st->dest.mode &= ~CALL_STATE_OPT;
for (i = st->first_named; i < st->dest.n; ++i) {
- sig = SIG_ITEM(st->dest.u.op.signature, i);
- if (!(sig & PARROT_ARG_NAME))
+ st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i);
+ if (!(st->dest.sig & PARROT_ARG_NAME))
continue;
- if (sig & PARROT_ARG_SLURPY_ARRAY) {
- st->dest.mode |= CALL_STATE_SLURP;
+ if (st->dest.sig & PARROT_ARG_SLURPY_ARRAY)
return 1;
- }
n_named++;
idx = st->dest.u.op.pc[i];
- param = PARROT_ARG_CONSTANT_ISSET(sig) ?
st->dest.ctx->constants[idx]->u.string
+ 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 || 0 == string_equal(interp, st->name, param)) {
++i;
@@ -633,10 +652,10 @@
return 1;
}
}
- st->dest.mode |= CALL_STATE_x_END;
return 0;
}
+
static void
store_arg(call_state *st, INTVAL idx)
{
@@ -656,6 +675,7 @@
}
}
+
static int
store_current_arg(Interp *interp, call_state *st)
{
@@ -674,18 +694,17 @@
int
Parrot_store_arg(Interp *interp, call_state *st)
{
- if (!store_current_arg(interp, st))
- return 0;
- if (!(st->dest.mode & CALL_STATE_x_NAMED))
- st->dest.mode |= CALL_STATE_NEXT_ARG;
- return 1;
+ return store_current_arg(interp, st);
}
static void
-create_slurpy_array(Interp *interp, call_state *st, INTVAL idx)
+create_slurpy_array(Interp *interp, call_state *st)
{
+ INTVAL idx = st->dest.u.op.pc[st->dest.i];
+ assert(idx >= 0);
+
st->dest.slurp =
pmc_new(interp, Parrot_get_ctx_HLL_type(interp,
enum_class_ResizablePMCArray));
@@ -694,8 +713,6 @@
dod_register_pmc(interp, st->dest.slurp);
CTX_REG_PMC(st->dest.ctx, idx) = st->dest.slurp;
- st->dest.mode |= CALL_STATE_SLURP;
- st->dest.mode &= ~CALL_STATE_OPT;
}
static void
@@ -825,11 +842,12 @@
void
Parrot_process_args(Interp *interp, call_state *st, arg_pass_t param_or_result)
{
- int state, opt_flag;
+ int has_arg, n_named;
int err_check = 1;
const char *action = (param_or_result == PARROT_PASS_RESULTS) ? "results"
: "params";
- INTVAL idx;
+ /* 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;
@@ -839,187 +857,152 @@
err_check = 0;
}
- if (!st->src.n)
- st->dest.mode |= CALL_STATE_END_x;
- if (!st->dest.n)
- st->dest.mode |= CALL_STATE_x_END;
init_call_stats(st);
- do {
- Parrot_fetch_arg(interp, st);
- state = st->dest.mode & CALL_STATE_MASK;
+ call_state_item *src = &st->src;
+ call_state_item *dest = &st->dest;
- /* finished if both are at end or src at end * and we are slurpying */
- if ((state & CALL_STATE_END_x) &&
- ((state & CALL_STATE_x_END) || (state & CALL_STATE_SLURP)))
- return;
+ /*
+ * 1st: Positional non-:slurpy
+ */
+ for (; dest->i < dest->n; dest->i++) {
+ INTVAL idx;
- /*
- * handle state changes
- */
- if (!(state & CALL_STATE_NAMED_x)) {
- if (!(state & CALL_STATE_SLURP) &&
- (st->dest.sig & (PARROT_ARG_SLURPY_ARRAY|PARROT_ARG_NAME))
- == PARROT_ARG_SLURPY_ARRAY) {
- /* create dest slurp array */
- idx = st->dest.u.op.pc[st->dest.i];
- assert(idx >= 0);
- create_slurpy_array(interp, st, idx);
- state = CALL_STATE_POS_POS_SLURP;
- }
- /* positional src -> named src */
- if (st->name) {
- st->dest.mode |= CALL_STATE_NAMED_x;
-
- if (state == CALL_STATE_POS_POS_SLURP) {
- /* stop slurpy array */
- st->dest.slurp = NULL;
- st->dest.mode &= ~CALL_STATE_SLURP;
- /*
- * work around bad interaction of _NEXT_ARG
- * and flattening (which always advances to next)
- * TODO rewrite all again, now that all pieces are
- * together
- */
- if (st->src.mode & CALL_STATE_FLATTEN) {
- if (!next_arg(interp, &st->dest)) {
- st->dest.mode |= CALL_STATE_x_END;
- }
- }
- else {
- st->src.mode &= ~CALL_STATE_NEXT_ARG;
- st->dest.mode |= CALL_STATE_NEXT_ARG;
- continue;
- }
- }
- }
- }
+ /* check if the next dest arg is :slurpy */
+ next_arg_sig(interp, dest);
+ if (dest->sig & PARROT_ARG_SLURPY_ARRAY)
+ break;
- /* first dest named arg, setup for recieving of named args */
- if (!(state & CALL_STATE_x_NAMED) && (st->dest.sig & PARROT_ARG_NAME))
{
- /* pos -> named dest */
- init_first_dest_named(interp, st);
- }
+ /* 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);
- state = st->dest.mode & CALL_STATE_MASK;
- switch (state) {
- case CALL_STATE_NAMED_NAMED:
- case CALL_STATE_NAMED_NAMED_OPT:
- if (!locate_named_named(interp, st))
- real_exception(interp, NULL, E_ValueError,
- "too many named arguments - '%Ss' not expected",
st->name);
- if (st->dest.mode & CALL_STATE_SLURP)
- state |= CALL_STATE_SLURP;
- break;
- case CALL_STATE_POS_NAMED:
- locate_pos_named(interp, st);
+ /* if the src arg is named, we're done here */
+ if (st->name)
+ 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 (st->dest.sig & PARROT_ARG_OPTIONAL) {
- st->dest.mode |= CALL_STATE_OPT;
- state |= CALL_STATE_OPT;
- }
- else if (state & CALL_STATE_SLURP) {
- st->dest.sig &= ~PARROT_ARG_TYPE_MASK;
- st->dest.sig |= PARROT_ARG_PMC;
+
+ /* 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];
+ assert(idx >= 0);
+ store_arg(st, idx);
+
+ /* if we're at an :optional argument, we need to check for an
:opt_flag */
+ if (dest->sig & PARROT_ARG_OPTIONAL)
+ check_for_opt_flag(interp, st, has_arg);
+ }
- switch (state) {
- case CALL_STATE_POS_POS:
- st->dest.mode |= CALL_STATE_NEXT_ARG;
- Parrot_convert_arg(interp, st);
- store_current_arg(interp, st);
- break;
- case CALL_STATE_NAMED_NAMED:
- case CALL_STATE_POS_NAMED:
- Parrot_convert_arg(interp, st);
- store_current_arg(interp, st);
- break;
+ /*
+ * 2nd: Positional :slurpy
+ */
+ if (dest->sig & PARROT_ARG_SLURPY_ARRAY && !(dest->sig & PARROT_ARG_NAME))
{
+ PMC *array = pmc_new(interp, enum_class_ResizablePMCArray);
- case CALL_STATE_NAMED_NAMED_OPT:
- case CALL_STATE_POS_POS_OPT:
- opt_flag = 1;
-
- store_opt:
- ++st->optionals;
- Parrot_convert_arg(interp, st);
- store_current_arg(interp, st);
-
- /* :opt_flag is truely optional */
- if (!next_arg(interp, &st->dest)) {
- /* do nothing */
- }
- else if (!(st->dest.sig & PARROT_ARG_OPT_FLAG)) {
- st->dest.i--;
- }
- else
- {
- int idx = st->dest.u.op.pc[st->dest.i];
- --st->params;
- assert(idx >= 0);
- CTX_REG_INT(st->dest.ctx, idx) = opt_flag;
- }
- if (!(state & CALL_STATE_x_NAMED))
- st->dest.mode |= CALL_STATE_NEXT_ARG;
- break;
- case CALL_STATE_END_POS_OPT:
- null_val(st->dest.sig, st);
- opt_flag = 0;
- goto store_opt;
- case CALL_STATE_POS_POS_SLURP:
- Parrot_convert_arg(interp, st);
- VTABLE_push_pmc(interp, st->dest.slurp, UVal_pmc(st->val));
- break;
- case CALL_STATE_NAMED_NAMED_SLURP:
- Parrot_convert_arg(interp, st);
- VTABLE_set_pmc_keyed_str(interp, st->dest.slurp, st->name,
UVal_pmc(st->val));
+ INTVAL idx = st->dest.u.op.pc[dest->i];
+ assert(idx >= 0);
+ /* Must register this PMC or it may get collected when only the struct
+ * references it. */
+ dod_register_pmc(interp, array);
+ 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;
- case CALL_STATE_END_NAMED_NAMED|CALL_STATE_OPT:
- case CALL_STATE_END_NAMED_NAMED:
- case CALL_STATE_END_POS_NAMED:
- check_named(interp, st, action);
- return;
+ src->used = 1;
- /* error conditions */
- case CALL_STATE_END_x:
- if (err_check)
- too_few(interp, st, action);
- return;
- case CALL_STATE_x_END|CALL_STATE_OPT:
- case CALL_STATE_x_END:
- if (err_check)
- too_many(interp, st, action);
- return;
- case CALL_STATE_END_x|CALL_STATE_SLURP:
- /* this happens when flattening an empty array into a slurpy */
- return;
- case CALL_STATE_NAMED_POS:
- case CALL_STATE_NAMED_POS_OPT:
- case CALL_STATE_NAMED_POS_SLURP:
- real_exception(interp, NULL, E_ValueError, "too many named
arguments");
- break;
- case CALL_STATE_NAMED_x|CALL_STATE_x_NAMED|CALL_STATE_x_END:
- /* XXX: this state doesn't properly reflect what's going on */
- real_exception(interp, NULL, 0,
- "positional inside named args at position %i",
st->src.i-1);
- break;
- default:
- real_exception(interp, NULL, 0, "Unhandled process_args state
0x%x", state);
- break;
+ /* we have to convert to a PMC to 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));
}
- } while (1);
+
+ dest->i++;
+ dod_unregister_pmc(interp, array);
+ }
+
+ /* is there another argument? if we're thowing 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)
+ real_exception(interp, NULL, 0,
+ "positional inside named args at position %i",
+ st->src.i - n_named);
+
+ if (!locate_named_named(interp, st))
+ real_exception(interp, NULL, E_ValueError,
+ "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);
+ store_current_arg(interp, st);
+
+ /* if we're at an :optional argument, we need to 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, action);
+ /* we may or may not have registered this pmc */
+ dod_unregister_pmc(interp, dest->slurp);
}
void
Parrot_convert_arg(Interp *interp, call_state *st)
{
-#define END_OF_ARGS(x) (x.i >= x.n)
- /* if END OF SRC or DEST ARGS, no need to convert */
- if ((END_OF_ARGS(st->src) || END_OF_ARGS(st->dest)))
- return;
-
/* register key args have to be cloned */
if ((st->src.sig & PARROT_ARG_TYPE_MASK) == PARROT_ARG_PMC)
clone_key_arg(interp, st);
@@ -1042,7 +1025,6 @@
case PARROT_ARG_PMC:
convert_arg_from_pmc(interp, st);
break;
-
}
}
Modified: trunk/t/op/calling.t
==============================================================================
--- trunk/t/op/calling.t (original)
+++ trunk/t/op/calling.t Mon Apr 23 18:39:22 2007
@@ -2373,7 +2373,7 @@
/positional inside named args at position 2/
OUTPUT
-pir_output_like( <<'CODE', <<'OUTPUT', "unexpected positional arg", todo =>
'unimplemented' );
+pir_output_like( <<'CODE', <<'OUTPUT', "unexpected positional arg" );
.sub 'main'
'foo'('abc', 'def'=>1, 'ghi', 'jkl'=>1)
.end
@@ -2386,8 +2386,7 @@
/positional inside named args at position 3/
OUTPUT
-pir_output_is(
- <<'CODE', <<'OUTPUT', "RT #40490 - flat/slurpy named arguments", todo =>
'unimplemented' );
+pir_output_is( <<'CODE', <<'OUTPUT', "RT #40490 - flat/slurpy named arguments"
);
.sub 'main' :main
.local pmc args
args = new .Hash
Modified: trunk/t/op/cc_state.t
==============================================================================
--- trunk/t/op/cc_state.t (original)
+++ trunk/t/op/cc_state.t Mon Apr 23 18:39:22 2007
@@ -64,8 +64,7 @@
pcc_ok(
{ params => ".param pmc abc :optional :slurpy" },
- 'G4: optional slurpy param may be empty',
- todo => 'cc processor state missing',
+ 'G4: optional slurpy param may be empty'
);
pcc_like(
Modified: trunk/t/pmc/mmd.t
==============================================================================
--- trunk/t/pmc/mmd.t (original)
+++ trunk/t/pmc/mmd.t Mon Apr 23 18:39:22 2007
@@ -347,7 +347,7 @@
end
.pcc_sub Integer_bxor_Intval:
# the destination is optional, depending on the infix op used
- get_params "(0,0,0x20,0x40)", P5, I5, P6, I7
+ get_params "(0,0,0x80,0x100)", P5, I5, P6, I7
print "ok\n"
set I10, P5
bxor I11, I10, I5
Modified: trunk/tools/build/nativecall.pl
==============================================================================
--- trunk/tools/build/nativecall.pl (original)
+++ trunk/tools/build/nativecall.pl Mon Apr 23 18:39:22 2007
@@ -370,36 +370,44 @@
set_nci_I(Interp *interp, call_state *st, INTVAL val)
{
Parrot_init_ret_nci(interp, st, "I");
- UVal_int(st->val) = val;
- Parrot_convert_arg(interp, st);
- Parrot_store_arg(interp, st);
+ if (st->dest.i < st->dest.n) {
+ UVal_int(st->val) = val;
+ Parrot_convert_arg(interp, st);
+ Parrot_store_arg(interp, st);
+ }
}
static void
set_nci_N(Interp *interp, call_state *st, FLOATVAL val)
{
Parrot_init_ret_nci(interp, st, "N");
- UVal_num(st->val) = val;
- Parrot_convert_arg(interp, st);
- Parrot_store_arg(interp, st);
+ if (st->dest.i < st->dest.n) {
+ UVal_num(st->val) = val;
+ Parrot_convert_arg(interp, st);
+ Parrot_store_arg(interp, st);
+ }
}
static void
set_nci_S(Interp *interp, call_state *st, STRING *val)
{
Parrot_init_ret_nci(interp, st, "S");
- UVal_str(st->val) = val;
- Parrot_convert_arg(interp, st);
- Parrot_store_arg(interp, st);
+ if (st->dest.i < st->dest.n) {
+ UVal_str(st->val) = val;
+ Parrot_convert_arg(interp, st);
+ Parrot_store_arg(interp, st);
+ }
}
static void
set_nci_P(Interp *interp, call_state *st, PMC* val)
{
Parrot_init_ret_nci(interp, st, "P");
- UVal_pmc(st->val) = val;
- Parrot_convert_arg(interp, st);
- Parrot_store_arg(interp, st);
+ if (st->dest.i < st->dest.n) {
+ UVal_pmc(st->val) = val;
+ Parrot_convert_arg(interp, st);
+ Parrot_store_arg(interp, st);
+ }
}
/* All our static functions that call in various ways. Yes, terribly
