[svn:parrot] r41476 - in branches/pcc_arg_unify_2_0: compilers/imcc include/parrot lib/Parrot/Pmc2c src src/call src/ops tools/build
bacek at svn.parrot.org
bacek at svn.parrot.org
Fri Sep 25 11:16:47 UTC 2009
Author: bacek
Date: Fri Sep 25 11:16:44 2009
New Revision: 41476
URL: https://trac.parrot.org/parrot/changeset/41476
Log:
Recover more stuff from pcc_arg_unify branch.
Modified:
branches/pcc_arg_unify_2_0/compilers/imcc/pbc.c
branches/pcc_arg_unify_2_0/include/parrot/call.h
branches/pcc_arg_unify_2_0/lib/Parrot/Pmc2c/PCCMETHOD.pm
branches/pcc_arg_unify_2_0/src/call/pcc.c
branches/pcc_arg_unify_2_0/src/exceptions.c
branches/pcc_arg_unify_2_0/src/ops/core.ops
branches/pcc_arg_unify_2_0/tools/build/nativecall.pl
Modified: branches/pcc_arg_unify_2_0/compilers/imcc/pbc.c
==============================================================================
--- branches/pcc_arg_unify_2_0/compilers/imcc/pbc.c Fri Sep 25 10:26:56 2009 (r41475)
+++ branches/pcc_arg_unify_2_0/compilers/imcc/pbc.c Fri Sep 25 11:16:44 2009 (r41476)
@@ -1124,8 +1124,9 @@
"add lexical '%s' to sub name '%Ss'\n",
n->name, sub->name);
- VTABLE_set_integer_keyed_str(interp, lex_info,
- lex_name, r->color);
+ Parrot_PCCINVOKE(interp, lex_info,
+ string_from_literal(interp, "declare_lex_preg"),
+ "SI->", lex_name, r->color);
/* next possible name */
n = n->reg;
Modified: branches/pcc_arg_unify_2_0/include/parrot/call.h
==============================================================================
--- branches/pcc_arg_unify_2_0/include/parrot/call.h Fri Sep 25 10:26:56 2009 (r41475)
+++ branches/pcc_arg_unify_2_0/include/parrot/call.h Fri Sep 25 11:16:44 2009 (r41476)
@@ -35,20 +35,6 @@
typedef parrot_runloop_t Parrot_runloop;
-typedef enum {
- CALLSIGNATURE_is_exception_FLAG = PObj_private0_FLAG,
-} callsignature_flags_enum;
-
-#define CALLSIGNATURE_get_FLAGS(o) (PObj_get_FLAGS(o))
-#define CALLSIGNATURE_flag_TEST(flag, o) (CALLSIGNATURE_get_FLAGS(o) & CALLSIGNATURE_ ## flag ## _FLAG)
-#define CALLSIGNATURE_flag_SET(flag, o) (CALLSIGNATURE_get_FLAGS(o) |= CALLSIGNATURE_ ## flag ## _FLAG)
-#define CALLSIGNATURE_flag_CLEAR(flag, o) (CALLSIGNATURE_get_FLAGS(o) &= ~(UINTVAL)(CALLSIGNATURE_ ## flag ## _FLAG))
-
-/* Mark if the CallSignature is for an exception handler */
-#define CALLSIGNATURE_is_exception_TEST(o) CALLSIGNATURE_flag_TEST(is_exception, (o))
-#define CALLSIGNATURE_is_exception_SET(o) CALLSIGNATURE_flag_SET(is_exception, (o))
-#define CALLSIGNATURE_is_exception_CLEAR(o) CALLSIGNATURE_flag_CLEAR(is_exception, (o))
-
typedef enum call_state_mode {
/* argument fetching/putting modes */
CALL_STATE_SIG = 0x100, /* runops, nci. In case we're interfacing with
@@ -230,17 +216,6 @@
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
-PMC* Parrot_pcc_build_sig_object_from_op(PARROT_INTERP,
- ARGIN_NULLOK(PMC *signature),
- ARGIN(PMC * const raw_sig),
- ARGIN(opcode_t * const raw_args))
- __attribute__nonnull__(1)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4);
-
-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),
@@ -249,62 +224,9 @@
__attribute__nonnull__(3);
PARROT_EXPORT
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-PMC* Parrot_pcc_build_sig_object_returns_from_op(PARROT_INTERP,
- ARGIN_NULLOK(PMC *signature),
- ARGIN(PMC *raw_sig),
- ARGIN(opcode_t *raw_args))
- __attribute__nonnull__(1)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4);
-
-PARROT_EXPORT
-void Parrot_pcc_fill_params_from_c_args(PARROT_INTERP,
- ARGMOD(PMC *call_object),
- ARGIN(const char *signature),
- ...)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- FUNC_MODIFIES(*call_object);
-
-PARROT_EXPORT
-void Parrot_pcc_fill_params_from_op(PARROT_INTERP,
- ARGMOD(PMC *call_object),
- ARGIN(PMC *raw_sig),
- ARGIN(opcode_t *raw_params))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4)
- FUNC_MODIFIES(*call_object);
-
-PARROT_EXPORT
-void Parrot_pcc_fill_returns_from_c_args(PARROT_INTERP,
- ARGMOD(PMC *call_object),
- ARGIN(const char *signature),
- ...)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- FUNC_MODIFIES(*call_object);
-
-PARROT_EXPORT
-void Parrot_pcc_fill_returns_from_op(PARROT_INTERP,
- ARGMOD(PMC *call_object),
- ARGIN(PMC *raw_sig),
- ARGIN(opcode_t *raw_returns))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4)
- FUNC_MODIFIES(*call_object);
-
-PARROT_EXPORT
void Parrot_pcc_invoke_from_sig_object(PARROT_INTERP,
ARGIN(PMC *sub_obj),
- ARGIN(PMC *call_object))
+ ARGIN(PMC *sig_obj))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3);
@@ -429,47 +351,15 @@
PARROT_ASSERT_ARG(interp) \
&& PARROT_ASSERT_ARG(src_ctx) \
&& PARROT_ASSERT_ARG(dest_ctx)
-#define ASSERT_ARGS_Parrot_pcc_build_sig_object_from_op \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- && PARROT_ASSERT_ARG(raw_sig) \
- && PARROT_ASSERT_ARG(raw_args)
#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_pcc_build_sig_object_returns_from_op \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- && PARROT_ASSERT_ARG(raw_sig) \
- && PARROT_ASSERT_ARG(raw_args)
-#define ASSERT_ARGS_Parrot_pcc_fill_params_from_c_args \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- && PARROT_ASSERT_ARG(call_object) \
- && PARROT_ASSERT_ARG(signature)
-#define ASSERT_ARGS_Parrot_pcc_fill_params_from_op \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- && PARROT_ASSERT_ARG(call_object) \
- && PARROT_ASSERT_ARG(raw_sig) \
- && PARROT_ASSERT_ARG(raw_params)
-#define ASSERT_ARGS_Parrot_pcc_fill_returns_from_c_args \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- && PARROT_ASSERT_ARG(call_object) \
- && PARROT_ASSERT_ARG(signature)
-#define ASSERT_ARGS_Parrot_pcc_fill_returns_from_op \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- && PARROT_ASSERT_ARG(call_object) \
- && PARROT_ASSERT_ARG(raw_sig) \
- && PARROT_ASSERT_ARG(raw_returns)
#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(call_object)
+ && 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) \
Modified: branches/pcc_arg_unify_2_0/lib/Parrot/Pmc2c/PCCMETHOD.pm
==============================================================================
--- branches/pcc_arg_unify_2_0/lib/Parrot/Pmc2c/PCCMETHOD.pm Fri Sep 25 10:26:56 2009 (r41475)
+++ branches/pcc_arg_unify_2_0/lib/Parrot/Pmc2c/PCCMETHOD.pm Fri Sep 25 11:16:44 2009 (r41476)
@@ -79,22 +79,10 @@
our $reg_type_info = {
# s is string, ss is short string, at is arg type
- +(REGNO_INT) => { s => "INTVAL",
- ss => "INT",
- pcc => 'I',
- at => PARROT_ARG_INTVAL},
- +(REGNO_NUM) => { s => "FLOATVAL",
- ss => "NUM",
- pcc => "N",
- at => PARROT_ARG_FLOATVAL, },
- +(REGNO_STR) => { s => "STRING*",
- ss => "STR",
- pcc => "S",
- at => PARROT_ARG_STRING, },
- +(REGNO_PMC) => { s => "PMC*",
- ss => "PMC",
- pcc => "P",
- at => PARROT_ARG_PMC, },
+ +(REGNO_INT) => { s => "INTVAL", ss => "INT", at => PARROT_ARG_INTVAL, },
+ +(REGNO_NUM) => { s => "FLOATVAL", ss => "NUM", at => PARROT_ARG_FLOATVAL, },
+ +(REGNO_STR) => { s => "STRING*", ss => "STR", at => PARROT_ARG_STRING, },
+ +(REGNO_PMC) => { s => "PMC*", ss => "PMC", at => PARROT_ARG_PMC, },
};
# Perl trim function to remove whitespace from the start and end of the string
@@ -122,10 +110,10 @@
=head3 C<parse_adverb_attributes>
builds and returs an adverb hash from an adverb string such as
- ":optional :opt_flag :slurpy"
+ ":optional :optflag :slurpy"
{
optional =>1,
- opt_flag =>1,
+ optflag =>1,
slurpy =>1,
}
@@ -149,26 +137,6 @@
croak "$_ not recognized as INTVAL, FLOATVAL, STRING, or PMC";
}
-sub gen_arg_pcc_sig {
- my ($param) = @_;
-
- return 'Ip'
- if exists $param->{attrs}{opt_flag};
-
- my $sig = $reg_type_info->{ $param->{type} }->{pcc};
- $sig .= 'c' if exists $param->{attrs}{constant};
- $sig .= 'f' if exists $param->{attrs}{flatten};
- $sig .= 'i' if exists $param->{attrs}{invocant};
- $sig .= 'l' if exists $param->{attrs}{lookahead};
- $sig .= 'n' if (exists $param->{attrs}{name} ||
- exists $param->{attrs}{named});
- $sig .= 'o' if exists $param->{attrs}{optional};
- $sig .= 'p' if exists $param->{attrs}{opt_flag};
- $sig .= 's' if exists $param->{attrs}{slurpy};
-
- return $sig;
-}
-
sub gen_arg_flags {
my ($param) = @_;
@@ -194,11 +162,14 @@
my $tiss = $reg_type_info->{$reg_type}{ss}; #reg_type_info short string
if ( 'arg' eq $arg_type ) {
- return "$tis $name = CTX_REG_$tiss(_ctx, $index);\n";
+ return " $tis $name = CTX_REG_$tiss(_ctx, $index);\n";
}
elsif ( 'result' eq $arg_type ) {
return " $name = CTX_REG_$tiss(_ctx, $index);\n";
}
+ elsif ( 'name' eq $arg_type ) {
+ return " CTX_REG_$tiss(_ctx, $index) = CONST_STRING_GEN(interp, $name);\n";
+ }
else { #$arg_type eq 'param' or $arg_type eq 'return'
return " CTX_REG_$tiss(_ctx, $index) = $name;\n";
}
@@ -214,6 +185,8 @@
my ( $self, $pmc ) = @_;
my $method_name = $self->name;
my $body = $self->body;
+ my $regs_used = [];
+ my $qty_returns = 0;
my $signature_re = qr/
(RETURN #method name
@@ -233,6 +206,7 @@
last unless $matched;
}
+ $qty_returns++;
$matched =~ /$signature_re/;
my ( $match, $returns ) = ( $1, $2 );
@@ -241,7 +215,7 @@
if ($returns eq 'void') {
$e->emit( <<"END", __FILE__, __LINE__ + 1 );
/*BEGIN RETURN $returns */
- return;
+ goto no_return;
/*END RETURN $returns */
END
$matched->replace( $match, $e );
@@ -249,23 +223,40 @@
}
my $goto_string = "goto ${method_name}_returns;";
- my ( $returns_signature, $returns_varargs ) =
+ my ( $returns_n_regs_used, $returns_indexes, $returns_flags, $returns_accessors ) =
process_pccmethod_args( parse_p_args_string($returns), 'return' );
+ $returns_indexes = "0" unless $returns_indexes;
+
+ push @$regs_used, $returns_n_regs_used;
$e->emit( <<"END", __FILE__, __LINE__ + 1 );
{
/*BEGIN RETURN $returns */
+ /*BEGIN GENERATED ACCESSORS */
+END
+ $e->emit(<<"END");
+$returns_accessors
END
+
+ my $returns_sig = make_arg_pmc($returns_flags, '_return_sig');
+
$e->emit( <<"END", __FILE__, __LINE__ + 1 );
- Parrot_pcc_fill_returns_from_c_args(interp, _call_object, "$returns_signature",
- $returns_varargs);
- return;
+ /*END GENERATED ACCESSORS */
+ {
+ opcode_t _temp_return_indexes[] = { $returns_indexes };
+ _return_indexes = _temp_return_indexes;
+ }
+
+ _return_sig = pmc_new(interp, enum_class_FixedIntegerArray);
+$returns_sig
+ $goto_string
/*END RETURN $returns */
}
END
$matched->replace( $match, $e );
}
+ return $regs_used, $qty_returns;
}
sub parse_p_args_string {
@@ -314,20 +305,16 @@
sub process_pccmethod_args {
my ( $linear_args, $arg_type ) = @_;
+ my $n_regs_used_a = [ 0, 0, 0, 0 ]; # INT, FLOAT, STRING, PMC counts
my $args = [ [], [], [], [] ]; # actual INT, FLOAT, STRING, PMC
- my $signature = "";
- my @vararg_list = ();
- my $varargs = "";
- my $declarations = "";
+ my $args_indexes_a = []; # arg index into interp context
+ my $args_flags_a = []; # arg flags
+ my $args_accessors = "";
+ my $named_names = "";
for my $arg (@$linear_args) {
my ( $named, $named_name ) = is_named($arg);
- my $type = $arg->{type};
- my $name = $arg->{name};
if ($named) {
- my $tis = $reg_type_info->{+(REGNO_STR)}{s}; #reg_type_info string
- my $dummy_name = "_param_name_str_". $named_name;
- $dummy_name =~ s/"//g;
my $argn = {
type => +(REGNO_STR),
name => $named_name,
@@ -336,25 +323,22 @@
$arg->{named_name} = $named_name;
push @{ $args->[ +(REGNO_STR) ] }, $argn;
- $signature .= 'Sn';
- $declarations .= "$tis $dummy_name = CONST_STRING_GEN(interp, $named_name);\n";
- push @vararg_list, $dummy_name;
+ $argn->{index} = $n_regs_used_a->[ +(REGNO_STR) ]++;
+ push @$args_indexes_a, $argn->{index};
+ push @$args_flags_a, PARROT_ARG_STRING | PARROT_ARG_NAME;
+ $named_names .= gen_arg_accessor( $argn, 'name' );
}
- push @{ $args->[ $type ] }, $arg;
- $signature .= gen_arg_pcc_sig($arg);
- if ( $arg_type eq 'arg' ) {
- my $tis = $reg_type_info->{$type}{s}; #reg_type_info string
- $declarations .= "$tis $name;\n";
- push @vararg_list, "&$name"
- }
- elsif ( $arg_type eq 'return' ) {
- push @vararg_list, "$name";
- }
+ push @{ $args->[ $arg->{type} ] }, $arg;
+ $arg->{index} = $n_regs_used_a->[ $arg->{type} ]++;
+ push @$args_indexes_a, $arg->{index};
+ push @$args_flags_a, gen_arg_flags($arg);
+ $args_accessors .= gen_arg_accessor( $arg, $arg_type );
}
- $varargs = join ", ", @vararg_list;
- return ( $signature, $varargs, $declarations );
+ my $n_regs_used = join( ", ", @$n_regs_used_a );
+ my $args_indexes = join( ", ", @$args_indexes_a );
+ return ( $n_regs_used_a, $args_indexes, $args_flags_a, $args_accessors, $named_names );
}
sub find_max_regs {
@@ -383,53 +367,115 @@
my $e = Parrot::Pmc2c::Emitter->new( $pmc->filename );
my $e_post = Parrot::Pmc2c::Emitter->new( $pmc->filename );
- # parse pccmethod parameters, then unshift the PMC arg for the invocant
+ # parse pccmethod parameters, then unshift the a PMC arg for the invocant
my $linear_args = parse_p_args_string( $self->parameters );
unshift @$linear_args,
{
type => convert_type_string_to_reg_type('PMC'),
name => 'pmc',
- attrs => parse_adverb_attributes(':invocant')
+ attrs => parse_adverb_attributes(':object')
};
- # The invocant is already passed in the C signature, why pass it again?
- my ( $params_signature, $params_varargs, $params_declarations ) =
+ my ( $params_n_regs_used, $params_indexes, $params_flags, $params_accessors, $named_names ) =
process_pccmethod_args( $linear_args, 'arg' );
- rewrite_RETURNs( $self, $pmc );
+ my ( $n_regs, $qty_returns ) = rewrite_RETURNs( $self, $pmc );
rewrite_pccinvoke( $self, $pmc );
+ unshift @$n_regs, $params_n_regs_used;
+ my $n_regs_used = find_max_regs($n_regs);
+
+ my $set_params = make_arg_pmc($params_flags, '_param_sig');
$e->emit( <<"END", __FILE__, __LINE__ + 1 );
- PMC *_caller_ctx, *_ctx, *_ccont, *_call_object;
+ const INTVAL _n_regs_used[] = { $n_regs_used };
+ opcode_t _param_indexes[] = { $params_indexes };
+ opcode_t *_return_indexes;
+ opcode_t *_current_args;
+ PMC * const _param_sig = pmc_new(interp, enum_class_FixedIntegerArray);
+ PMC *_return_sig = PMCNULL;
+
+ PMC *_caller_ctx = interp->ctx;
+ PMC * const _ret_cont = new_ret_continuation_pmc(interp, NULL);
+ PMC *_ctx = Parrot_push_context(interp, _n_regs_used);
+ PMC *_ccont = PMCNULL;
+
+$set_params
+ UNUSED(_return_indexes);
+
+ if (_caller_ctx) {
+ _ccont = Parrot_pcc_get_continuation(interp, _caller_ctx);
+ }
+ else {
+ /* there is no point calling Parrot_ex_throw_from_c_args here, because
+ PDB_backtrace can't deal with a missing to_ctx either. */
+ exit_fatal(1, "No caller_ctx for continuation \%p.", _ccont);
+ }
- _ctx = CURRENT_CONTEXT(interp);
- _ccont = Parrot_pcc_get_continuation(interp, _ctx);
+ Parrot_pcc_set_continuation(interp, _ctx, _ret_cont);
+ PARROT_CONTINUATION(_ret_cont)->from_ctx = _ctx;
- _caller_ctx = Parrot_pcc_get_caller_ctx(interp, _ctx);
- _call_object = Parrot_pcc_get_current_sig(interp, _ctx);
- Parrot_pcc_set_current_sig(interp, _ctx, NULL);
+ _current_args = interp->current_args;
+ interp->current_args = NULL;
- { /* BEGIN PARMS SCOPE */
END
$e->emit(<<"END");
-$params_declarations
-END
- if ($params_signature) {
- $e->emit( <<"END", __FILE__, __LINE__ + 1 );
- Parrot_pcc_fill_params_from_c_args(interp, _call_object, "$params_signature",
- $params_varargs);
+$named_names
END
+ $e->emit( <<"END", __FILE__, __LINE__ + 1 );
+
+ interp->params_signature = _param_sig;
+ parrot_pass_args(interp, _caller_ctx, _ctx, _current_args, _param_indexes,
+ PARROT_PASS_PARAMS);
+
+ if (PObj_get_FLAGS(_ccont) & SUB_FLAG_TAILCALL) {
+ PObj_get_FLAGS(_ccont) &= ~SUB_FLAG_TAILCALL;
+ Parrot_pcc_dec_recursion_depth(interp, _ctx);
+ Parrot_pcc_set_caller_ctx(interp, _ctx, Parrot_pcc_get_caller_ctx(interp, _caller_ctx));
+ interp->current_args = NULL;
}
+ /* BEGIN PARMS SCOPE */
+ {
+END
+ $e->emit(<<"END");
+$params_accessors
+END
$e->emit( <<"END", __FILE__, __LINE__ + 1 );
- { /* BEGIN PMETHOD BODY */
+
+ /* BEGIN PMETHOD BODY */
+ {
END
+ my $method_returns = $self->name . "_returns:";
$e_post->emit( <<"END", __FILE__, __LINE__ + 1 );
- } /* END PMETHOD BODY */
- } /* END PARAMS SCOPE */
+ }
+ goto no_return;
+ /* END PMETHOD BODY */
+
+END
+ if ($qty_returns) {
+ $e_post->emit( <<"END", __FILE__, __LINE__ + 1 );
+$method_returns
+
+ if (! _caller_ctx) {
+ /* there is no point calling Parrot_ex_throw_from_c_args here, because
+ PDB_backtrace can't deal with a missing to_ctx either. */
+ exit_fatal(1, "No caller_ctx for continuation \%p.", _ccont);
+ }
+
+ interp->returns_signature = _return_sig;
+ parrot_pass_args(interp, _ctx, _caller_ctx, _return_indexes,
+ Parrot_pcc_get_results(interp, _caller_ctx), PARROT_PASS_RESULTS);
+END
+ }
+ $e_post->emit( <<"END", __FILE__, __LINE__ + 1 );
+
+ /* END PARAMS SCOPE */
+ }
no_return:
- return;
+ PObj_live_CLEAR(_param_sig);
+ PObj_live_CLEAR(_return_sig);
+ Parrot_pop_context(interp);
END
$self->return_type('void');
$self->parameters('');
@@ -495,7 +541,7 @@
$vars .= $out_vars;
my $e = Parrot::Pmc2c::Emitter->new( $pmc->filename );
- $e->emit(qq|Parrot_pcc_invoke_method_from_c_args($fixed_params, "$signature", $vars);\n|);
+ $e->emit(qq|Parrot_PCCINVOKE($fixed_params, "$signature", $vars);\n|);
$matched->replace( $match, $e );
}
@@ -579,7 +625,7 @@
flatten => 'f',
slurpy => 's',
optional => 'o',
- opt_flag => 'p',
+ positional => 'p',
);
my @arg_names = ($name);
Modified: branches/pcc_arg_unify_2_0/src/call/pcc.c
==============================================================================
--- branches/pcc_arg_unify_2_0/src/call/pcc.c Fri Sep 25 10:26:56 2009 (r41475)
+++ branches/pcc_arg_unify_2_0/src/call/pcc.c Fri Sep 25 11:16:44 2009 (r41476)
@@ -105,26 +105,18 @@
__attribute__nonnull__(2)
FUNC_MODIFIES(*st);
-static void dissect_aggregate_arg(PARROT_INTERP,
- ARGMOD(PMC *call_object),
- ARGIN(PMC *aggregate))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- FUNC_MODIFIES(*call_object);
-
-static void extract_named_arg_from_op(PARROT_INTERP,
- ARGMOD(PMC *call_object),
- ARGIN(STRING *name),
- ARGIN(PMC * const raw_sig),
- ARGIN(opcode_t * const raw_args),
- INTVAL arg_index)
+PARROT_CANNOT_RETURN_NULL
+static PMC * 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)
- __attribute__nonnull__(5)
- FUNC_MODIFIES(*call_object);
+ FUNC_MODIFIES(*args_sig)
+ FUNC_MODIFIES(*results_sig);
static int fetch_arg_op(PARROT_INTERP, ARGMOD(call_state *st))
__attribute__nonnull__(1)
@@ -160,18 +152,6 @@
FUNC_MODIFIES(*st);
PARROT_CAN_RETURN_NULL
-static void parse_signature_string(PARROT_INTERP,
- ARGIN(const char *signature),
- ARGMOD(PMC **arg_flags),
- ARGMOD(PMC **return_flags))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4)
- FUNC_MODIFIES(*arg_flags)
- FUNC_MODIFIES(*return_flags);
-
-PARROT_CAN_RETURN_NULL
static const char * set_context_sig_params(PARROT_INTERP,
ARGIN(const char *signature),
ARGMOD(INTVAL *n_regs_used),
@@ -205,6 +185,18 @@
FUNC_MODIFIES(*indexes)
FUNC_MODIFIES(*result_list);
+static void set_context_sig_returns_varargs(PARROT_INTERP,
+ ARGMOD(PMC *ctx),
+ ARGMOD(opcode_t **indexes),
+ ARGIN(const char *ret_x),
+ va_list returns)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3)
+ __attribute__nonnull__(4)
+ FUNC_MODIFIES(*ctx)
+ FUNC_MODIFIES(*indexes);
+
static int set_retval_util(PARROT_INTERP,
ARGIN(const char *sig),
ARGIN(PMC *ctx),
@@ -278,16 +270,11 @@
#define ASSERT_ARGS_convert_arg_from_str __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
&& PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_dissect_aggregate_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+#define ASSERT_ARGS_count_signature_elements __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
- && PARROT_ASSERT_ARG(call_object) \
- && PARROT_ASSERT_ARG(aggregate)
-#define ASSERT_ARGS_extract_named_arg_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- && PARROT_ASSERT_ARG(call_object) \
- && PARROT_ASSERT_ARG(name) \
- && PARROT_ASSERT_ARG(raw_sig) \
- && PARROT_ASSERT_ARG(raw_args)
+ && 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)
@@ -307,11 +294,6 @@
&& PARROT_ASSERT_ARG(sti)
#define ASSERT_ARGS_null_val __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_parse_signature_string __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- && PARROT_ASSERT_ARG(signature) \
- && PARROT_ASSERT_ARG(arg_flags) \
- && PARROT_ASSERT_ARG(return_flags)
#define ASSERT_ARGS_set_context_sig_params __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
&& PARROT_ASSERT_ARG(signature) \
@@ -325,6 +307,12 @@
&& 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)
#define ASSERT_ARGS_set_retval_util __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
&& PARROT_ASSERT_ARG(sig) \
@@ -354,330 +342,6 @@
/*
-=item C<PMC* Parrot_pcc_build_sig_object_from_op(PARROT_INTERP, PMC *signature,
-PMC * const raw_sig, opcode_t * const raw_args)>
-
-Take a raw signature and argument list from a set_args opcode and
-convert it to a CallSignature PMC.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-PMC*
-Parrot_pcc_build_sig_object_from_op(PARROT_INTERP, ARGIN_NULLOK(PMC *signature),
- ARGIN(PMC * const raw_sig), ARGIN(opcode_t * const raw_args))
-{
- ASSERT_ARGS(Parrot_pcc_build_sig_object_from_op)
- PMC *call_object;
- INTVAL arg_index;
- INTVAL arg_count = VTABLE_elements(interp, raw_sig);
- PMC *ctx = CURRENT_CONTEXT(interp);
- STRING *string_sig = Parrot_str_new(interp, "", 0);
-
- if (PMC_IS_NULL(signature)) {
- call_object = pmc_new(interp, enum_class_CallSignature);
- gc_register_pmc(interp, call_object);
- }
- else
- call_object = signature;
-
- VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "arg_flags"), raw_sig);
-
- for (arg_index = 0; arg_index < arg_count; arg_index++) {
- INTVAL arg_flags = VTABLE_get_integer_keyed_int(interp,
- raw_sig, arg_index);
-
- const INTVAL constant = PARROT_ARG_CONSTANT_ISSET(arg_flags);
- const INTVAL raw_index = raw_args[arg_index + 2];
-
- switch (PARROT_ARG_TYPE_MASK_MASK(arg_flags)) {
- case PARROT_ARG_INTVAL:
- string_sig = Parrot_str_append(interp, string_sig, CONST_STRING(interp, "I"));
- if (constant)
- VTABLE_push_integer(interp, call_object, raw_index);
- else
- VTABLE_push_integer(interp, call_object, CTX_REG_INT(ctx, raw_index));
- break;
- case PARROT_ARG_FLOATVAL:
- string_sig = Parrot_str_append(interp, string_sig, CONST_STRING(interp, "N"));
- if (constant)
- VTABLE_push_float(interp, call_object,
- Parrot_pcc_get_num_constant(interp, ctx, raw_index));
- else
- VTABLE_push_float(interp, call_object, CTX_REG_NUM(ctx, raw_index));
- break;
- case PARROT_ARG_STRING:
- {
- STRING *string_value;
- string_sig = Parrot_str_append(interp, string_sig, CONST_STRING(interp, "S"));
- if (constant)
- /* ensure that callees don't modify constant caller strings */
- string_value = Parrot_str_new_COW(interp,
- Parrot_pcc_get_string_constant(interp, ctx, raw_index));
- else
- string_value = CTX_REG_STR(ctx, raw_index);
-
- if (arg_flags & PARROT_ARG_NAME) {
- string_sig = Parrot_str_append(interp, string_sig, CONST_STRING(interp, "n"));
- extract_named_arg_from_op(interp, call_object, string_value,
- raw_sig, raw_args, raw_index);
- }
- else
- VTABLE_push_string(interp, call_object, string_value);
-
- break;
- }
- case PARROT_ARG_PMC:
- {
- PMC *pmc_value;
- string_sig = Parrot_str_append(interp, string_sig, CONST_STRING(interp, "P"));
- if (constant)
- pmc_value = Parrot_pcc_get_pmc_constant(interp, ctx, raw_index);
- else
- pmc_value = CTX_REG_PMC(ctx, raw_index);
-
- if (arg_flags & PARROT_ARG_FLATTEN) {
- dissect_aggregate_arg(interp, call_object, pmc_value);
- string_sig = Parrot_str_append(interp, string_sig, CONST_STRING(interp, "f"));
- }
- else
- VTABLE_push_pmc(interp, call_object, CTX_REG_PMC(ctx, raw_index));
-
- break;
- }
- default:
- break;
- }
-
- }
-
- VTABLE_set_string_native(interp, call_object, string_sig);
- return call_object;
-}
-
-/*
-
-=item C<static void extract_named_arg_from_op(PARROT_INTERP, PMC *call_object,
-STRING *name, PMC * const raw_sig, opcode_t * const raw_args, INTVAL arg_index)>
-
-Pulls in the next argument from a set_args opcode, and sets it as the
-value of a named argument in the CallSignature PMC.
-
-=cut
-
-*/
-
-static void
-extract_named_arg_from_op(PARROT_INTERP, ARGMOD(PMC *call_object), ARGIN(STRING *name),
- ARGIN(PMC * const raw_sig), ARGIN(opcode_t * const raw_args),
- INTVAL arg_index)
-{
- ASSERT_ARGS(extract_named_arg_from_op)
- PMC *ctx = CURRENT_CONTEXT(interp);
- INTVAL arg_flags = VTABLE_get_integer_keyed_int(interp,
- raw_sig, arg_index);
-
- const INTVAL constant = PARROT_ARG_CONSTANT_ISSET(arg_flags);
- const INTVAL raw_index = raw_args[arg_index + 2];
- STRING *string_sig = VTABLE_get_string(interp, call_object);
-
- switch (PARROT_ARG_TYPE_MASK_MASK(arg_flags)) {
- case PARROT_ARG_INTVAL:
- string_sig = Parrot_str_append(interp, string_sig, CONST_STRING(interp, "I"));
- if (constant)
- VTABLE_set_integer_keyed_str(interp, call_object, name, raw_index);
- else
- VTABLE_set_integer_keyed_str(interp, call_object, name,
- CTX_REG_INT(ctx, raw_index));
- break;
- case PARROT_ARG_FLOATVAL:
- string_sig = Parrot_str_append(interp, string_sig, CONST_STRING(interp, "N"));
- if (constant)
- VTABLE_set_number_keyed_str(interp, call_object, name,
- Parrot_pcc_get_num_constant(interp, ctx, raw_index));
- else
- VTABLE_set_number_keyed_str(interp, call_object, name,
- CTX_REG_NUM(ctx, raw_index));
- break;
- case PARROT_ARG_STRING:
- string_sig = Parrot_str_append(interp, string_sig, CONST_STRING(interp, "S"));
- if (constant)
- /* ensure that callees don't modify constant caller strings */
- VTABLE_set_string_keyed_str(interp, call_object, name,
- Parrot_str_new_COW(interp,
- Parrot_pcc_get_string_constant(interp, ctx, raw_index)));
- else
- VTABLE_set_string_keyed_str(interp, call_object, name,
- CTX_REG_STR(ctx, raw_index));
- break;
- case PARROT_ARG_PMC:
- string_sig = Parrot_str_append(interp, string_sig, CONST_STRING(interp, "P"));
- if (constant)
- VTABLE_set_pmc_keyed_str(interp, call_object, name,
- Parrot_pcc_get_pmc_constant(interp, ctx, raw_index));
- else
- VTABLE_set_pmc_keyed_str(interp, call_object, name,
- CTX_REG_PMC(ctx, raw_index));
- break;
- default:
- break;
- }
-
- VTABLE_set_string_native(interp, call_object, string_sig);
-}
-
-/*
-
-=item C<static void dissect_aggregate_arg(PARROT_INTERP, PMC *call_object, PMC
-*aggregate)>
-
-Takes an aggregate PMC and splits it up into individual arguments,
-adding each one to the CallSignature PMC. If the aggregate is an array,
-its elements are added as positional arguments. If the aggregate is a
-hash, its key/value pairs are added as named arguments.
-
-=cut
-
-*/
-
-static void
-dissect_aggregate_arg(PARROT_INTERP, ARGMOD(PMC *call_object), ARGIN(PMC *aggregate))
-{
- ASSERT_ARGS(dissect_aggregate_arg)
-
- if (VTABLE_does(interp, aggregate, CONST_STRING(interp, "array"))) {
- INTVAL elements = VTABLE_elements(interp, aggregate);
- INTVAL index;
- for (index = 0; index < elements; index++) {
- VTABLE_push_pmc(interp, call_object,
- VTABLE_get_pmc_keyed_int(interp, aggregate, index));
- }
- }
- else if (VTABLE_does(interp, aggregate, CONST_STRING(interp, "hash"))) {
- INTVAL elements = VTABLE_elements(interp, aggregate);
- INTVAL index;
- PMC *key = pmc_new(interp, enum_class_Key);
- VTABLE_set_integer_native(interp, key, 0);
- SETATTR_Key_next_key(interp, key, (PMC *)INITBucketIndex);
-
- /* Low-level hash iteration. */
- for (index = 0; index < elements; index++) {
- if (!PMC_IS_NULL(key)) {
- STRING *name = (STRING *)parrot_hash_get_idx(interp,
- (Hash *)VTABLE_get_pointer(interp, aggregate), key);
- PARROT_ASSERT(name);
- VTABLE_set_pmc_keyed_str(interp, call_object, name,
- VTABLE_get_pmc_keyed_str(interp, aggregate, name));
- }
- }
- }
- else {
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "flattened parameters must be a hash or array");
- }
-
-}
-
-/*
-
-=item C<PMC* Parrot_pcc_build_sig_object_returns_from_op(PARROT_INTERP, PMC
-*signature, PMC *raw_sig, opcode_t *raw_args)>
-
-Take a raw signature and argument list from a set_results opcode and
-convert it to a CallSignature PMC. Uses an existing CallSignature PMC if
-one was already created for set_args. Otherwise, creates a new one.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-PMC*
-Parrot_pcc_build_sig_object_returns_from_op(PARROT_INTERP, ARGIN_NULLOK(PMC *signature),
- ARGIN(PMC *raw_sig), ARGIN(opcode_t *raw_args))
-{
- ASSERT_ARGS(Parrot_pcc_build_sig_object_returns_from_op)
- PMC *call_object;
- STRING *string_sig;
- INTVAL arg_index;
- INTVAL arg_count = VTABLE_elements(interp, raw_sig);
- PMC *ctx = CURRENT_CONTEXT(interp);
- PMC *returns = pmc_new(interp, enum_class_ResizablePMCArray);
-
- if (PMC_IS_NULL(signature)) {
- call_object = pmc_new(interp, enum_class_CallSignature);
- gc_register_pmc(interp, call_object);
- }
- else
- call_object = signature;
-
- string_sig = VTABLE_get_string(interp, call_object);
-
- /* A hack to support 'get_results' as the way of fetching the
- * exception object inside an exception handler. The first argument
- * in the call object is the exception, stick it directly into the
- * destination register. */
- if (CALLSIGNATURE_is_exception_TEST(call_object)) {
- const INTVAL raw_index = raw_args[2];
- CTX_REG_PMC(ctx, raw_index) =
- VTABLE_get_pmc_keyed_int(interp, call_object, 0);
- return NULL;
- }
-
- VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "return_flags"), raw_sig);
- VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "returns"), returns);
- string_sig = Parrot_str_append(interp, string_sig, CONST_STRING(interp, "->"));
-
- for (arg_index = 0; arg_index < arg_count; arg_index++) {
- STRING * const signature = CONST_STRING(interp, "signature");
- INTVAL arg_flags = VTABLE_get_integer_keyed_int(interp,
- raw_sig, arg_index);
- const INTVAL raw_index = raw_args[arg_index + 2];
-
- /* Returns store a pointer to the register, 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 (PARROT_ARG_TYPE_MASK_MASK(arg_flags)) {
- case PARROT_ARG_INTVAL:
- string_sig = Parrot_str_append(interp, string_sig, CONST_STRING(interp, "I"));
- VTABLE_set_pointer(interp, val_pointer, (void *) &(CTX_REG_INT(ctx, raw_index)));
- VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "I"));
- break;
- case PARROT_ARG_FLOATVAL:
- string_sig = Parrot_str_append(interp, string_sig, CONST_STRING(interp, "N"));
- VTABLE_set_pointer(interp, val_pointer, (void *) &(CTX_REG_NUM(ctx, raw_index)));
- VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "N"));
- break;
- case PARROT_ARG_STRING:
- string_sig = Parrot_str_append(interp, string_sig, CONST_STRING(interp, "S"));
- VTABLE_set_pointer(interp, val_pointer, (void *) &(CTX_REG_STR(ctx, raw_index)));
- VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "S"));
- break;
- case PARROT_ARG_PMC:
- string_sig = Parrot_str_append(interp, string_sig, CONST_STRING(interp, "P"));
- VTABLE_set_pointer(interp, val_pointer, (void *) &(CTX_REG_PMC(ctx, raw_index)));
- VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "P"));
- break;
- default:
- break;
- }
-
- }
-
- VTABLE_set_string_native(interp, call_object, string_sig);
- return call_object;
-}
-
-/*
-
=item C<PMC* Parrot_pcc_build_sig_object_from_varargs(PARROT_INTERP, PMC *obj,
const char *sig, va_list args)>
@@ -699,8 +363,6 @@
ASSERT_ARGS(Parrot_pcc_build_sig_object_from_varargs)
PMC *type_tuple = PMCNULL;
PMC *returns = PMCNULL;
- PMC *arg_flags = PMCNULL;
- PMC *return_flags = PMCNULL;
PMC * const 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);
@@ -711,9 +373,6 @@
return call_object;
VTABLE_set_string_native(interp, call_object, string_sig);
- parse_signature_string(interp, sig, &arg_flags, &return_flags);
- VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "arg_flags"), arg_flags);
- VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "return_flags"), return_flags);
/* Process the varargs list */
for (i = 0; i < sig_len; ++i) {
@@ -722,7 +381,7 @@
/* 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, "returns"), returns);
+ VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "results"), returns);
}
if (in_return_sig) {
@@ -752,7 +411,7 @@
default:
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_INVALID_OPERATION,
- "Dispatch: invalid argument type %c!", type);
+ "Multiple Dispatch: invalid argument type %c!", type);
}
}
else {
@@ -768,758 +427,32 @@
VTABLE_push_string(interp, call_object, va_arg(args, STRING *));
break;
case 'P':
- {
- INTVAL type_lookahead = Parrot_str_indexed(interp, string_sig, (i + 1));
- PMC * const pmc_arg = va_arg(args, PMC *);
- VTABLE_push_pmc(interp, call_object, pmc_arg);
- if (type_lookahead == 'i') {
- if (i != 0)
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "Dispatch: only the first argument can be an invocant");
- i++; /* skip 'i' */
- }
- break;
- }
- case '-':
- i++; /* skip '>' */
- in_return_sig = 1;
+ VTABLE_push_pmc(interp, call_object, va_arg(args, PMC *));
break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "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_pcc_fill_params_from_op(PARROT_INTERP, PMC *call_object, PMC
-*raw_sig, opcode_t *raw_params)>
-
-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, then the named parameters, and finally the named
-slurpy parameters.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_pcc_fill_params_from_op(PARROT_INTERP, ARGMOD(PMC *call_object),
- ARGIN(PMC *raw_sig), ARGIN(opcode_t *raw_params))
-{
- ASSERT_ARGS(Parrot_pcc_fill_params_from_op)
- PMC *ctx = CURRENT_CONTEXT(interp);
- INTVAL positional_elements = VTABLE_elements(interp, call_object);
- INTVAL param_count = VTABLE_elements(interp, raw_sig);
- STRING *param_name = NULL;
- INTVAL param_index = 0;
- INTVAL positional_index = 0;
- INTVAL named_count = 0;
- INTVAL slurpy_count = 0;
- INTVAL optional_count = 0;
- INTVAL err_check = 0;
- INTVAL got_optional = -1;
-
- /* Check if we should be throwing errors. This is configured separately
- * for parameters and return values. */
- if (PARROT_ERRORS_test(interp, PARROT_ERRORS_PARAM_COUNT_FLAG))
- err_check = 1;
-
- for (param_index = 0; param_index < param_count; param_index++) {
- INTVAL param_flags = VTABLE_get_integer_keyed_int(interp,
- raw_sig, param_index);
-
- const INTVAL raw_index = raw_params[param_index + 2];
-
- /* opt_flag parameter */
- if (param_flags & PARROT_ARG_OPT_FLAG) {
- if (optional_count <= 0)
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "optional flag with no optional parameter");
- if (got_optional < 0 || got_optional > 1)
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "unable to determine if optional argument was passed");
-
- CTX_REG_INT(ctx, raw_index) = got_optional;
- got_optional = -1;
- continue; /* on to next parameter */
- }
- /* Collected ("slurpy") parameter */
- else if (param_flags & PARROT_ARG_SLURPY_ARRAY) {
- /* Collect named arguments into hash */
- if (param_flags & PARROT_ARG_NAME) {
- PMC * const collect_named = pmc_new(interp,
- Parrot_get_ctx_HLL_type(interp, enum_class_Hash));
-
- CTX_REG_PMC(ctx, raw_index) = collect_named;
- named_count += VTABLE_elements(interp, collect_named);
- }
- /* Collect positional arguments into array */
- else {
- PMC *collect_positional;
- if (named_count > 0)
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "named parameters must follow all positional parameters");
- collect_positional = pmc_new(interp,
- Parrot_get_ctx_HLL_type(interp, enum_class_ResizablePMCArray));
- for (; positional_index < positional_elements; positional_index++) {
- VTABLE_push_pmc(interp, collect_positional,
- VTABLE_get_pmc_keyed_int(interp, call_object, positional_index));
- }
- CTX_REG_PMC(ctx, raw_index) = collect_positional;
- }
-
- continue; /* on to next parameter */
- }
- /* Named non-collected */
- else if (param_flags & PARROT_ARG_NAME) {
- /* Just store the name for now (this parameter is only the
- * name). The next parameter is the actual value. */
- param_name = PARROT_ARG_CONSTANT_ISSET(param_flags)
- ? Parrot_pcc_get_string_constant(interp, ctx, raw_index)
- : CTX_REG_STR(ctx, raw_index);
-
- continue;
- }
- else if (!STRING_IS_NULL(param_name)) {
- /* The previous parameter was a parameter name. Now set the
- * value of the named parameter.*/
- if (VTABLE_exists_keyed_str(interp, call_object, param_name)) {
- named_count++;
-
- switch (PARROT_ARG_TYPE_MASK_MASK(param_flags)) {
- case PARROT_ARG_INTVAL:
- CTX_REG_INT(ctx, raw_index) =
- VTABLE_get_integer_keyed_str(interp, call_object, param_name);
- break;
- case PARROT_ARG_FLOATVAL:
- CTX_REG_NUM(ctx, raw_index) =
- VTABLE_get_number_keyed_str(interp, call_object, param_name);
- break;
- case PARROT_ARG_STRING:
- CTX_REG_STR(ctx, raw_index) =
- VTABLE_get_string_keyed_str(interp, call_object, param_name);
- break;
- case PARROT_ARG_PMC:
- CTX_REG_PMC(ctx, raw_index) =
- VTABLE_get_pmc_keyed_str(interp, call_object, param_name);
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION, "invalid parameter type");
- break;
- }
- param_name = NULL;
- continue; /* on to next parameter */
- }
-
- /* If the named parameter doesn't have a corresponding named
- * argument, fall through to positional argument handling. */
- param_name = NULL;
- }
-
- /* Positional non-collected */
- if (named_count > 0)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "named parameters must follow all positional parameters");
- if (slurpy_count > 0)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "slurpy parameters must follow ordinary positional parameters");
-
- /* No more positional arguments available to assign */
- if (positional_index >= positional_elements) {
- if (!(param_flags & PARROT_ARG_OPTIONAL))
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "too few positional arguments: %d passed, %d (or more) expected",
- positional_elements, param_index + 1);
-
- got_optional = 0;
- optional_count++;
- switch (PARROT_ARG_TYPE_MASK_MASK(param_flags)) {
- case PARROT_ARG_INTVAL:
- CTX_REG_INT(ctx, raw_index) = 0;
- break;
- case PARROT_ARG_FLOATVAL:
- CTX_REG_NUM(ctx, raw_index) = 0.0;
- break;
- case PARROT_ARG_STRING:
- CTX_REG_STR(ctx, raw_index) = NULL;
- break;
- case PARROT_ARG_PMC:
- CTX_REG_PMC(ctx, raw_index) = PMCNULL;
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION, "invalid parameter type");
- break;
- }
-
- continue; /* on to next parameter */
- }
-
- /* Otherwise, we have a positional argument to assign to the
- * positional parameter, so go ahead and assign it. */
- if (param_flags & PARROT_ARG_OPTIONAL) {
- got_optional = 1;
- optional_count++;
- }
-
- switch (PARROT_ARG_TYPE_MASK_MASK(param_flags)) {
- case PARROT_ARG_INTVAL:
- CTX_REG_INT(ctx, raw_index) =
- VTABLE_get_integer_keyed_int(interp, call_object, positional_index);
- positional_index++;
- break;
- case PARROT_ARG_FLOATVAL:
- CTX_REG_NUM(ctx, raw_index) =
- VTABLE_get_number_keyed_int(interp, call_object, positional_index);
- positional_index++;
- break;
- case PARROT_ARG_STRING:
- CTX_REG_STR(ctx, raw_index) =
- VTABLE_get_string_keyed_int(interp, call_object, positional_index);
- positional_index++;
- break;
- case PARROT_ARG_PMC:
- CTX_REG_PMC(ctx, raw_index) =
- VTABLE_get_pmc_keyed_int(interp, call_object, positional_index);
- positional_index++;
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION, "invalid parameter type");
- break;
- }
- }
-
- if (err_check && (positional_elements > positional_index))
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "too many positional arguments: %d passed, %d expected",
- positional_elements, param_count);
-
-}
-
-/*
-
-=item C<void Parrot_pcc_fill_params_from_c_args(PARROT_INTERP, PMC *call_object,
-const char *signature, ...)>
-
-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, then the named parameters, and finally the named
-slurpy parameters.
-
-The signature is a string in the format used for
-C<Parrot_pcc_invoke_from_sig_object>, but with no return arguments. The
-parameters are passed in as a list of references to the destination
-variables.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_pcc_fill_params_from_c_args(PARROT_INTERP, ARGMOD(PMC *call_object),
- ARGIN(const char *signature), ...)
-{
- ASSERT_ARGS(Parrot_pcc_fill_params_from_c_args)
- va_list args;
- Parrot_Context *ctx = CONTEXT(interp);
- INTVAL positional_elements = VTABLE_elements(interp, call_object);
- INTVAL param_count = 0;
- STRING *param_name = NULL;
- INTVAL param_index = 0;
- INTVAL positional_index = 0;
- INTVAL named_count = 0;
- INTVAL slurpy_count = 0;
- INTVAL optional_count = 0;
- INTVAL err_check = 0;
- INTVAL got_optional = -1;
- PMC *raw_sig = PMCNULL;
- PMC *invalid_sig = PMCNULL;
-
- parse_signature_string(interp, signature, &raw_sig, &invalid_sig);
- if (!PMC_IS_NULL(invalid_sig))
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "returns should not be included in the parameter list");
- param_count = VTABLE_elements(interp, raw_sig);
-
- /* Check if we should be throwing errors. This is configured separately
- * for parameters and return values. */
- if (PARROT_ERRORS_test(interp, PARROT_ERRORS_PARAM_COUNT_FLAG))
- err_check = 1;
-
- va_start(args, signature);
- for (param_index = 0; param_index < param_count; param_index++) {
- INTVAL param_flags = VTABLE_get_integer_keyed_int(interp,
- raw_sig, param_index);
-
- /* opt_flag parameter */
- if (param_flags & PARROT_ARG_OPT_FLAG) {
- if (optional_count <= 0)
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "optional flag with no optional parameter");
- if (got_optional < 0 || got_optional > 1)
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "unable to determine if optional argument was passed");
-
- {
- INTVAL * const int_pointer = va_arg(args, INTVAL*);
- *int_pointer = got_optional;
- }
- got_optional = -1;
- continue; /* on to next parameter */
- }
- /* Collected ("slurpy") parameter */
- else if (param_flags & PARROT_ARG_SLURPY_ARRAY) {
- /* Collect named arguments into hash */
- if (param_flags & PARROT_ARG_NAME) {
- PMC * const collect_named = pmc_new(interp,
- Parrot_get_ctx_HLL_type(interp, enum_class_Hash));
-
- {
- PMC ** const pmc_pointer = va_arg(args, PMC**);
- *pmc_pointer = collect_named;
- }
- named_count += VTABLE_elements(interp, collect_named);
- }
- /* Collect positional arguments into array */
- else {
- PMC *collect_positional;
- if (named_count > 0)
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "named parameters must follow all positional parameters");
- collect_positional = pmc_new(interp,
- Parrot_get_ctx_HLL_type(interp, enum_class_ResizablePMCArray));
- for (; positional_index < positional_elements; positional_index++) {
- VTABLE_push_pmc(interp, collect_positional,
- VTABLE_get_pmc_keyed_int(interp, call_object, positional_index));
- }
- {
- PMC ** const pmc_pointer = va_arg(args, PMC**);
- *pmc_pointer = collect_positional;
- }
- }
-
- continue; /* on to next parameter */
- }
- /* Named non-collected */
- else if (param_flags & PARROT_ARG_NAME) {
- /* Just store the name for now (this parameter is only the
- * name). The next parameter is the actual value. */
- STRING ** const string_pointer = va_arg(args, STRING**);
- param_name = *string_pointer;
-
- continue; /* on to next parameter */
- }
- else if (!STRING_IS_NULL(param_name)) {
- /* The previous parameter was a parameter name. Now set the
- * value of the named parameter.*/
- if (VTABLE_exists_keyed_str(interp, call_object, param_name)) {
- named_count++;
-
- switch (PARROT_ARG_TYPE_MASK_MASK(param_flags)) {
- case PARROT_ARG_INTVAL:
- {
- INTVAL * const int_pointer = va_arg(args, INTVAL*);
- *int_pointer =
- VTABLE_get_integer_keyed_str(interp, call_object, param_name);
- }
- break;
- case PARROT_ARG_FLOATVAL:
- {
- FLOATVAL * const float_pointer = va_arg(args, FLOATVAL*);
- *float_pointer =
- VTABLE_get_number_keyed_str(interp, call_object, param_name);
- }
- break;
- case PARROT_ARG_STRING:
- {
- STRING ** const string_pointer = va_arg(args, STRING**);
- *string_pointer =
- VTABLE_get_string_keyed_str(interp, call_object, param_name);
- }
- break;
- case PARROT_ARG_PMC:
- {
- PMC ** const pmc_pointer = va_arg(args, PMC**);
- *pmc_pointer =
- VTABLE_get_pmc_keyed_str(interp, call_object, param_name);
- }
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION, "invalid parameter type");
- break;
- }
- param_name = NULL;
- continue; /* on to next parameter */
- }
-
- /* If the named parameter doesn't have a corresponding named
- * argument, fall through to positional argument handling. */
- param_name = NULL;
- }
-
- /* Positional non-collected */
- if (named_count > 0)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "named parameters must follow all positional parameters");
- if (slurpy_count > 0)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "slurpy parameters must follow ordinary positional parameters");
-
- /* No more positional arguments available to assign */
- if (positional_index >= positional_elements) {
- if (!param_flags & PARROT_ARG_OPTIONAL)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "too few positional arguments: %d passed, %d (or more) expected",
- positional_elements, param_index + 1);
-
- got_optional = 0;
- optional_count++;
- switch (PARROT_ARG_TYPE_MASK_MASK(param_flags)) {
- case PARROT_ARG_INTVAL:
- {
- INTVAL * const int_pointer = va_arg(args, INTVAL*);
- *int_pointer = 0;
- }
- break;
- case PARROT_ARG_FLOATVAL:
- {
- FLOATVAL * const float_pointer = va_arg(args, FLOATVAL*);
- *float_pointer = 0.0;
- }
- break;
- case PARROT_ARG_STRING:
- {
- STRING ** const string_pointer = va_arg(args, STRING**);
- *string_pointer = NULL;
- }
- break;
- case PARROT_ARG_PMC:
- {
- PMC ** const pmc_pointer = va_arg(args, PMC**);
- *pmc_pointer = PMCNULL;
- }
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION, "invalid parameter type");
- break;
- }
-
- continue; /* on to next parameter */
- }
-
- /* Otherwise, we have a positional argument to assign to the
- * positional parameter, so go ahead and assign it. */
- if (param_flags & PARROT_ARG_OPTIONAL) {
- got_optional = 1;
- optional_count++;
- }
-
- switch (PARROT_ARG_TYPE_MASK_MASK(param_flags)) {
- case PARROT_ARG_INTVAL:
- {
- INTVAL * const int_pointer = va_arg(args, INTVAL*);
- *int_pointer =
- VTABLE_get_integer_keyed_int(interp, call_object, positional_index);
- }
- positional_index++;
- break;
- case PARROT_ARG_FLOATVAL:
- {
- FLOATVAL * const float_pointer = va_arg(args, FLOATVAL*);
- *float_pointer =
- VTABLE_get_number_keyed_int(interp, call_object, positional_index);
- }
- positional_index++;
- break;
- case PARROT_ARG_STRING:
- {
- STRING ** const string_pointer = va_arg(args, STRING**);
- *string_pointer =
- VTABLE_get_string_keyed_int(interp, call_object, positional_index);
- }
- positional_index++;
- break;
- case PARROT_ARG_PMC:
- {
- PMC ** const pmc_pointer = va_arg(args, PMC**);
- *pmc_pointer =
- VTABLE_get_pmc_keyed_int(interp, call_object, positional_index);
- }
- positional_index++;
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION, "invalid parameter type");
- break;
- }
- }
- va_end(args);
-}
-
-/*
-
-=item C<void Parrot_pcc_fill_returns_from_op(PARROT_INTERP, PMC *call_object,
-PMC *raw_sig, opcode_t *raw_returns)>
-
-Sets return values for the current function call. First it sets the
-positional returns, then the named returns.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_pcc_fill_returns_from_op(PARROT_INTERP, ARGMOD(PMC *call_object),
- ARGIN(PMC *raw_sig), ARGIN(opcode_t *raw_returns))
-{
- ASSERT_ARGS(Parrot_pcc_fill_returns_from_op)
- INTVAL return_list_elements;
- PMC *ctx = CURRENT_CONTEXT(interp);
- PMC * const return_list = VTABLE_get_attr_str(interp, call_object, CONST_STRING(interp, "returns"));
- PMC * const caller_return_flags = VTABLE_get_attr_str(interp, call_object, CONST_STRING(interp, "return_flags"));
- INTVAL raw_return_count = VTABLE_elements(interp, raw_sig);
- INTVAL return_index = 0;
- INTVAL return_list_index = 0;
- INTVAL err_check = 0;
-
- /* Check if we should be throwing errors. This is configured separately
- * for parameters and return values. */
- if (PARROT_ERRORS_test(interp, PARROT_ERRORS_RESULT_COUNT_FLAG))
- err_check = 1;
-
- if (PMC_IS_NULL(return_list)) {
- if (err_check)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "too many return values: %d passed, 0 expected",
- raw_return_count, return_list_elements);
- return;
- }
- else
- return_list_elements = VTABLE_elements(interp, return_list);
-
-
- if (raw_return_count > return_list_elements) {
- if (err_check)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "too many return values: %d passed, %d expected",
- raw_return_count, return_list_elements);
- }
-
- for (return_index = 0; return_index < raw_return_count; return_index++) {
- INTVAL return_flags = VTABLE_get_integer_keyed_int(interp,
- raw_sig, return_index);
- INTVAL result_flags;
-
- const INTVAL constant = PARROT_ARG_CONSTANT_ISSET(return_flags);
- const INTVAL raw_index = raw_returns[return_index + 2];
- PMC *result_item = VTABLE_get_pmc_keyed_int(interp, return_list, return_list_index);
- STRING *item_sig;
-
- /* Gracefully ignore extra returns when error checking is off. */
- if (PMC_IS_NULL(result_item))
- continue; /* Go on to next return arg. */
-
- result_flags = VTABLE_get_integer_keyed_int(interp, caller_return_flags, return_list_index);
- item_sig = VTABLE_get_string_keyed_str(interp, result_item, CONST_STRING(interp, ''));
-
- switch (PARROT_ARG_TYPE_MASK_MASK(return_flags)) {
- case PARROT_ARG_INTVAL:
- if (Parrot_str_equal(interp, item_sig, CONST_STRING(interp, "P"))) {
- VTABLE_set_pmc(interp, result_item,
- pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_Integer)));
- }
- if (constant)
- VTABLE_set_integer_native(interp, result_item, raw_index);
- else
- VTABLE_set_integer_native(interp, result_item, CTX_REG_INT(ctx, raw_index));
- return_list_index++;
- break;
- case PARROT_ARG_FLOATVAL:
- if (Parrot_str_equal(interp, item_sig, CONST_STRING(interp, "P"))) {
- VTABLE_set_pmc(interp, result_item,
- pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_Float)));
- }
- if (constant)
- VTABLE_set_number_native(interp, result_item,
- Parrot_pcc_get_num_constant(interp, ctx, raw_index));
- else
- VTABLE_set_number_native(interp, result_item, CTX_REG_NUM(ctx, raw_index));
- return_list_index++;
- break;
- case PARROT_ARG_STRING:
- if (Parrot_str_equal(interp, item_sig, CONST_STRING(interp, "P"))) {
- VTABLE_set_pmc(interp, result_item,
- pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_String)));
- }
- if (constant)
- VTABLE_set_string_native(interp, result_item,
- Parrot_str_new_COW(interp,
- Parrot_pcc_get_string_constant(interp, ctx, raw_index)));
- else
- VTABLE_set_string_native(interp, result_item, CTX_REG_STR(ctx, raw_index));
- return_list_index++;
- break;
- case PARROT_ARG_PMC:
- if (constant)
- VTABLE_set_pmc(interp, result_item,
- Parrot_pcc_get_pmc_constant(interp, ctx, raw_index));
- else
- VTABLE_set_pmc(interp, result_item, CTX_REG_PMC(ctx, raw_index));
- return_list_index++;
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION, "invalid parameter type");
- 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);
+ }
}
}
-}
-
-/*
-
-=item C<void Parrot_pcc_fill_returns_from_c_args(PARROT_INTERP, PMC
-*call_object, const char *signature, ...)>
-
-Sets return values for the current function call. First it sets the
-positional returns, then the named returns.
-
-The signature is a string in the format used for
-C<Parrot_pcc_invoke_from_sig_object>, but with only return arguments.
-The parameters are passed in as a list of INTVAL, FLOATVAL, STRING *, or
-PMC * variables.
-
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_pcc_fill_returns_from_c_args(PARROT_INTERP, ARGMOD(PMC *call_object),
- ARGIN(const char *signature), ...)
-{
- ASSERT_ARGS(Parrot_pcc_fill_returns_from_c_args)
- va_list args;
- INTVAL return_list_elements;
- Parrot_Context *ctx = CONTEXT(interp);
- PMC * const return_list = VTABLE_get_attr_str(interp, call_object, CONST_STRING(interp, "returns"));
- INTVAL raw_return_count = 0;
- INTVAL return_index = 0;
- INTVAL return_list_index = 0;
- INTVAL err_check = 0;
-
- PMC *raw_sig = PMCNULL;
- PMC *invalid_sig = PMCNULL;
-
- parse_signature_string(interp, signature, &raw_sig, &invalid_sig);
- if (!PMC_IS_NULL(invalid_sig))
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "parameters should not be included in the return signature");
- raw_return_count = VTABLE_elements(interp, raw_sig);
-
- /* Check if we should be throwing errors. This is configured separately
- * for parameters and return values. */
- if (PARROT_ERRORS_test(interp, PARROT_ERRORS_RESULT_COUNT_FLAG))
- err_check = 1;
-
- if (PMC_IS_NULL(return_list)) {
- if (err_check)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "too many return values: %d passed, 0 expected",
- raw_return_count, return_list_elements);
- return;
- }
- else
- return_list_elements = VTABLE_elements(interp, return_list);
-
- if (raw_return_count > return_list_elements) {
- if (err_check)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "too many return values: %d passed, %d expected",
- raw_return_count, return_list_elements);
+ /* 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);
}
- va_start(args, signature);
- for (return_index = 0; return_index < raw_return_count; return_index++) {
- STRING *item_sig;
- INTVAL return_flags = VTABLE_get_integer_keyed_int(interp,
- raw_sig, return_index);
-
- PMC *result_item = VTABLE_get_pmc_keyed_int(interp, return_list, return_list_index);
-
- /* Gracefully ignore extra returns when error checking is off. */
- if (PMC_IS_NULL(result_item))
- continue; /* Go on to next return arg. */
-
- item_sig = VTABLE_get_string_keyed_str(interp, result_item, CONST_STRING(interp, ''));
+ /* 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);
- switch (PARROT_ARG_TYPE_MASK_MASK(return_flags)) {
- case PARROT_ARG_INTVAL:
- if (Parrot_str_equal(interp, item_sig, CONST_STRING(interp, "P"))) {
- VTABLE_set_pmc(interp, result_item, pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_Integer)));
- }
- VTABLE_set_integer_native(interp, result_item, va_arg(args, INTVAL));
- return_list_index++;
- break;
- case PARROT_ARG_FLOATVAL:
- if (Parrot_str_equal(interp, item_sig, CONST_STRING(interp, "P"))) {
- VTABLE_set_pmc(interp, result_item, pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_Float)));
- }
- VTABLE_set_number_native(interp, result_item, va_arg(args, FLOATVAL));
- return_list_index++;
- break;
- case PARROT_ARG_STRING:
- if (Parrot_str_equal(interp, item_sig, CONST_STRING(interp, "P"))) {
- VTABLE_set_pmc(interp, result_item, pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_String)));
- }
- VTABLE_set_string_native(interp, result_item,
- Parrot_str_new_COW(interp, va_arg(args, STRING *)));
- return_list_index++;
- break;
- case PARROT_ARG_PMC:
- VTABLE_set_pmc(interp, result_item, va_arg(args, PMC *));
- return_list_index++;
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION, "invalid parameter type");
- break;
- }
- }
- va_end(args);
+ return call_object;
}
@@ -3278,6 +2211,118 @@
/*
+=item C<static PMC * count_signature_elements(PARROT_INTERP, const char
+*signature, PMC *args_sig, PMC *results_sig, int flag)>
+
+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 PMC *
+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;
+
+ /*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 };
+
+ unsigned int seen_arrow = 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(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)>
@@ -3435,86 +2480,69 @@
/*
-=item C<static void parse_signature_string(PARROT_INTERP, const char *signature,
-PMC **arg_flags, PMC **return_flags)>
+=item C<static void set_context_sig_returns_varargs(PARROT_INTERP, PMC *ctx,
+opcode_t **indexes, const char *ret_x, va_list returns)>
+
+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>.
-Parses a signature string and creates call and return signature integer
-arrays. The two integer arrays should be passed in as references to a
-PMC.
+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
*/
-PARROT_CAN_RETURN_NULL
static void
-parse_signature_string(PARROT_INTERP, ARGIN(const char *signature),
- ARGMOD(PMC **arg_flags), ARGMOD(PMC **return_flags))
+set_context_sig_returns_varargs(PARROT_INTERP, ARGMOD(PMC *ctx),
+ ARGMOD(opcode_t **indexes), ARGIN(const char *ret_x), va_list returns)
{
- ASSERT_ARGS(parse_signature_string)
- PMC *current_array;
- const char *x;
- INTVAL flags = 0;
- INTVAL set = 0;
-
- if (PMC_IS_NULL(*arg_flags))
- *arg_flags = pmc_new(interp, enum_class_ResizableIntegerArray);
- current_array = *arg_flags;
-
- for (x = signature; *x != '\0'; x++) {
+ ASSERT_ARGS(set_context_sig_returns_varargs)
+ const char *x;
+ unsigned int index = 0;
+ unsigned int seen_arrow = 1;
- /* detect -> separator */
- if (*x == '-') {
- /* skip '>' */
- x++;
- /* Switch to the return argument flags. */
- if (PMC_IS_NULL(*return_flags))
- *return_flags = pmc_new(interp, enum_class_ResizableIntegerArray);
- current_array = *return_flags;
- }
- /* parse arg type */
- else if (isupper((unsigned char)*x)) {
- /* Starting a new argument, so store the previous argument,
- * if there was one. */
- if (set) {
- VTABLE_push_integer(interp, current_array, flags);
- set = 0;
- }
-
- switch (*x) {
- case 'I': flags = PARROT_ARG_INTVAL; set++; break;
- case 'N': flags = PARROT_ARG_FLOATVAL; set++; break;
- case 'S': flags = PARROT_ARG_STRING; set++; break;
- case 'P': flags = PARROT_ARG_PMC; set++; break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "invalid signature string element %c!", *x);
- }
-
- }
- /* parse arg adverbs */
- else if (islower((unsigned 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 'c': flags |= PARROT_ARG_CONSTANT; break;
- case 'f': flags |= PARROT_ARG_FLATTEN; break;
- case 'i': flags |= PARROT_ARG_INVOCANT; break;
- case 'l': flags |= PARROT_ARG_LOOKAHEAD; break;
- case 'n': flags |= PARROT_ARG_NAME; break;
- case 'o': flags |= PARROT_ARG_OPTIONAL; break;
- case 'p': flags |= PARROT_ARG_OPT_FLAG; break;
- case 's': flags |= PARROT_ARG_SLURPY_ARRAY; break;
+ 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,
- "invalid signature string element %c!", *x);
+ "Parrot_PCCINVOKE: invalid reg type %c!", *x);
}
}
}
- /* Store the final argument, if there was one. */
- if (set)
- VTABLE_push_integer(interp, current_array, flags);
+ Parrot_pop_context(interp);
}
@@ -3728,23 +2756,166 @@
ARGIN(const char *signature), ...)
{
ASSERT_ARGS(Parrot_PCCINVOKE)
- PMC *sig_obj;
- PMC *sub_obj;
- va_list args;
- va_start(args, signature);
- sig_obj = Parrot_pcc_build_sig_object_from_varargs(interp, pmc, signature, args);
- va_end(args);
+#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 };
- /* 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);
+ /* 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];
- /* Invoke the subroutine object with the given CallSignature object */
- interp->current_object = pmc;
- Parrot_pcc_invoke_from_sig_object(interp, sub_obj, sig_obj);
- gc_unregister_pmc(interp, sig_obj);
+ 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);
+
+ PMC *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;
+ Parrot_pcc_set_results(interp, ctx, result_indexes);
+ Parrot_pcc_set_results_signature(interp, ctx, results_sig);
+
+ /* arg_accessors assigned in loop above */
+
+ interp->current_object = pmc;
+ interp->current_cont = NEED_CONTINUATION;
+ Parrot_pcc_set_continuation(interp, ctx, ret_cont);
+ PMC_cont(ret_cont)->from_ctx = 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);
+ interp->current_args = save_current_args;
+ interp->args_signature = save_args_signature;
+ interp->current_object = save_current_object;
+ va_end(list);
}
/*
@@ -3787,7 +2958,6 @@
"Method '%Ss' not found", method_name);
/* Invoke the subroutine object with the given CallSignature object */
- interp->current_object = pmc;
Parrot_pcc_invoke_from_sig_object(interp, sub_obj, sig_obj);
gc_unregister_pmc(interp, sig_obj);
@@ -3797,7 +2967,7 @@
/*
=item C<void Parrot_pcc_invoke_from_sig_object(PARROT_INTERP, PMC *sub_obj, PMC
-*call_object)>
+*sig_obj)>
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
@@ -3810,19 +2980,75 @@
PARROT_EXPORT
void
Parrot_pcc_invoke_from_sig_object(PARROT_INTERP, ARGIN(PMC *sub_obj),
- ARGIN(PMC *call_object))
+ ARGIN(PMC *sig_obj))
{
ASSERT_ARGS(Parrot_pcc_invoke_from_sig_object)
-
- opcode_t *dest;
+#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 };
- PMC *ctx = Parrot_push_context(interp, n_regs_used);
- PMC * const ret_cont = new_ret_continuation_pmc(interp, NULL);
- Parrot_pcc_set_current_sig(interp, ctx, call_object);
+ /* Each of these is 8K. Do we want 16K on the stack? */
+ opcode_t arg_indexes[PCC_ARG_MAX] = {0};
+ opcode_t result_indexes[PCC_ARG_MAX] = {0};
+
+ /* 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"));
+
+ PMC *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 */
+ if (strncmp(signature, "Pi", 2) == 0)
+ interp->current_object = VTABLE_get_pmc_keyed_int(interp, sig_obj, 0);
+ else
+ interp->current_object = PMCNULL;
+
+ interp->current_cont = NEED_CONTINUATION;
Parrot_pcc_set_continuation(interp, ctx, ret_cont);
- interp->current_cont = NEED_CONTINUATION;
- PMC_cont(ret_cont)->from_ctx = ctx;
+ PMC_cont(ret_cont)->from_ctx = ctx;
/* Invoke the function */
dest = VTABLE_invoke(interp, sub_obj, NULL);
@@ -3840,9 +3066,18 @@
runops(interp, offset);
interp->run_core = old_core;
}
- gc_unregister_pmc(interp, call_object);
- Parrot_pcc_set_current_sig(interp, ctx, NULL);
- Parrot_pop_context(interp);
+
+ /* 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);
}
Modified: branches/pcc_arg_unify_2_0/src/exceptions.c
==============================================================================
--- branches/pcc_arg_unify_2_0/src/exceptions.c Fri Sep 25 10:26:56 2009 (r41475)
+++ branches/pcc_arg_unify_2_0/src/exceptions.c Fri Sep 25 11:16:44 2009 (r41476)
@@ -38,16 +38,24 @@
__attribute__nonnull__(3);
PARROT_CAN_RETURN_NULL
-static void pass_exception_args(PARROT_INTERP, ARGIN(const char *sig), ...)
+static opcode_t * pass_exception_args(PARROT_INTERP,
+ ARGIN(const char *sig),
+ ARGIN(opcode_t *dest),
+ ARGIN(PMC * old_ctx),
+ ...)
__attribute__nonnull__(1)
- __attribute__nonnull__(2);
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3)
+ __attribute__nonnull__(4);
#define ASSERT_ARGS_build_exception_from_args __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
&& PARROT_ASSERT_ARG(format)
#define ASSERT_ARGS_pass_exception_args __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
- && PARROT_ASSERT_ARG(sig)
+ && PARROT_ASSERT_ARG(sig) \
+ && PARROT_ASSERT_ARG(dest) \
+ && PARROT_ASSERT_ARG(old_ctx)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
@@ -232,7 +240,20 @@
}
address = VTABLE_invoke(interp, handler, dest);
- pass_exception_args(interp, "P", exception);
+
+ /* XXX This is an obvious hack. We need to identify here whether this is
+ an ExceptionHandler proper or a PIR-defined subclass. This conditional
+ monstrosity attempts to check whether this is an object of a PIR-defined
+ subclass. When we have garbage-collectable PMCs, we shouldn't need to do
+ this nonsense. See TT#154 for details */
+ if (handler->vtable->base_type == enum_class_Object) {
+ /* Don't know what to do here to make sure the exception parameter gets
+ passed properly. */
+ }
+ /* Set up the continuation context of the handler in the interpreter. */
+ else if (PARROT_CONTINUATION(handler)->current_results)
+ address = pass_exception_args(interp, "P", address,
+ CURRENT_CONTEXT(interp), exception);
if (PObj_get_FLAGS(handler) & SUB_FLAG_C_HANDLER) {
/* it's a C exception handler */
@@ -246,7 +267,8 @@
/*
-=item C<static void pass_exception_args(PARROT_INTERP, const char *sig, ...)>
+=item C<static opcode_t * pass_exception_args(PARROT_INTERP, const char *sig,
+opcode_t *dest, PMC * old_ctx, ...)>
Passes arguments to the exception handler routine. These are retrieved with
the .get_results() directive in PIR code.
@@ -256,20 +278,19 @@
*/
PARROT_CAN_RETURN_NULL
-static void
-pass_exception_args(PARROT_INTERP, ARGIN(const char *sig), ...)
+static opcode_t *
+pass_exception_args(PARROT_INTERP, ARGIN(const char *sig),
+ ARGIN(opcode_t *dest), ARGIN(PMC * old_ctx), ...)
{
ASSERT_ARGS(pass_exception_args)
- va_list args;
- PMC *sig_obj;
-
- va_start(args, sig);
- sig_obj = Parrot_pcc_build_sig_object_from_varargs(interp, PMCNULL, sig, args);
- va_end(args);
+ va_list ap;
+ opcode_t *next;
- CALLSIGNATURE_is_exception_SET(sig_obj);
+ va_start(ap, old_ctx);
+ next = parrot_pass_args_fromc(interp, sig, dest, old_ctx, ap);
+ va_end(ap);
- CONTEXT(interp)->current_sig = sig_obj;
+ return next;
}
/*
@@ -359,7 +380,6 @@
/* Don't split line. It will break CONST_STRING handling */
VTABLE_set_attr_str(interp, exception, CONST_STRING(interp, "thrower"), Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp)));
-
/* it's a C exception handler */
if (PObj_get_FLAGS(handler) & SUB_FLAG_C_HANDLER) {
Parrot_runloop * const jump_point =
@@ -369,10 +389,11 @@
/* Run the handler. */
address = VTABLE_invoke(interp, handler, NULL);
- pass_exception_args(interp, "P", exception);
+ if (PARROT_CONTINUATION(handler)->current_results)
+ address = pass_exception_args(interp, "P", address,
+ CURRENT_CONTEXT(interp), exception);
PARROT_ASSERT(return_point->handler_start == NULL);
return_point->handler_start = address;
-
longjmp(return_point->resume, 2);
}
Modified: branches/pcc_arg_unify_2_0/src/ops/core.ops
==============================================================================
--- branches/pcc_arg_unify_2_0/src/ops/core.ops Fri Sep 25 10:26:56 2009 (r41475)
+++ branches/pcc_arg_unify_2_0/src/ops/core.ops Fri Sep 25 11:16:44 2009 (r41476)
@@ -516,75 +516,93 @@
op set_args(inconst PMC) :flow {
- opcode_t * const raw_args = CUR_OPCODE;
+ opcode_t * const _this = CUR_OPCODE;
PMC * const signature = $1;
INTVAL argc;
- CONTEXT(interp)->current_sig =
- Parrot_pcc_build_sig_object_from_op(interp,
- PMCNULL, signature, raw_args);
-
+ /* for now just point to the opcode */
+ interp->current_args = _this;
argc = VTABLE_elements(interp, signature);
goto OFFSET(argc + 2);
}
op get_results(inconst PMC) :flow {
- opcode_t * const raw_returns = CUR_OPCODE;
+ opcode_t * const _this = CUR_OPCODE;
PMC * const signature = $1;
INTVAL argc;
- Parrot_pcc_set_current_sig(interp, CURRENT_CONTEXT(interp),
- Parrot_pcc_build_sig_object_returns_from_op(interp,
- Parrot_pcc_get_current_sig(interp, CURRENT_CONTEXT(interp)),
- signature, raw_returns));
-
+ Parrot_pcc_set_results(interp, CURRENT_CONTEXT(interp), _this);
argc = VTABLE_elements(interp, signature);
goto OFFSET(argc + 2);
}
op get_params(inconst PMC) :flow {
- opcode_t * const raw_params = CUR_OPCODE;
+ opcode_t * const _this = CUR_OPCODE;
PMC *caller_ctx, *ctx;
- PMC *ccont, *call_object;
+ PMC * ccont;
PMC * const signature = $1;
INTVAL argc;
+ opcode_t *src_indexes, *dst_indexes;
- ctx = CURRENT_CONTEXT(interp);
- ccont = Parrot_pcc_get_continuation(interp, ctx);
+ interp->current_params = _this;
+ ctx = CURRENT_CONTEXT(interp);
+ ccont = Parrot_pcc_get_continuation(interp, ctx);
- caller_ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
- call_object = Parrot_pcc_get_current_sig(interp, caller_ctx);
+ caller_ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
- Parrot_pcc_fill_params_from_op(interp, call_object, signature, raw_params);
+ src_indexes = interp->current_args;
+ dst_indexes = interp->current_params;
+ /* the args and params are now 'used.' */
+ interp->current_args = NULL;
+ interp->current_params = NULL;
+ parrot_pass_args(interp, caller_ctx, ctx, src_indexes, dst_indexes, PARROT_PASS_PARAMS);
/* TODO Factor out with Sub.invoke */
if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL) {
PObj_get_FLAGS(ccont) &= ~SUB_FLAG_TAILCALL;
Parrot_pcc_dec_recursion_depth(interp, ctx);
Parrot_pcc_set_caller_ctx(interp, ctx, Parrot_pcc_get_caller_ctx(interp, caller_ctx));
+ interp->current_args = NULL;
}
argc = VTABLE_elements(interp, signature);
goto OFFSET(argc + 2);
}
op set_returns(inconst PMC) :flow {
- opcode_t * const raw_returns = CUR_OPCODE;
+ opcode_t * const _this = CUR_OPCODE;
PMC *ctx, *caller_ctx;
- PMC *ccont, *call_object;
+ PMC *ccont;
PMC *signature = $1;
INTVAL argc;
+ opcode_t *src_indexes, *dest_indexes;
- ctx = CURRENT_CONTEXT(interp);
- ccont = Parrot_pcc_get_continuation(interp, ctx);
-
- caller_ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
- call_object = Parrot_pcc_get_current_sig(interp, caller_ctx);
-
- Parrot_pcc_fill_returns_from_op(interp, call_object, signature, raw_returns);
-
- gc_unregister_pmc(interp, call_object);
- Parrot_pcc_set_current_sig(interp, ctx, NULL);
+ interp->current_returns = _this;
+ ctx = CURRENT_CONTEXT(interp);
+ caller_ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
+ ccont = Parrot_pcc_get_continuation(interp, ctx);
+
+ if (PARROT_CONTINUATION(ccont)->address) {
+ /* Call is from runops_fromc */
+ caller_ctx = PMC_cont(ccont)->to_ctx;
+ if (PMC_IS_NULL(caller_ctx)) {
+ /* there is no point calling Parrot_ex_throw_..., because
+ PDB_backtrace can't deal with a missing to_ctx either. */
+ exit_fatal(1, "No caller_ctx for continuation %p.", ccont);
+ }
+ src_indexes = interp->current_returns;
+ dest_indexes = Parrot_pcc_get_results(interp, caller_ctx);
+ interp->current_returns = NULL;
+ /* does this need to be here */
+ interp->current_args = NULL;
+
+ parrot_pass_args(interp, ctx, caller_ctx, src_indexes, dest_indexes, PARROT_PASS_RESULTS);
+ }
+ else if (Parrot_pcc_get_results_signature(interp, caller_ctx)) {
+ /* We have a dynamic result signature, from pcc_invoke */
+ parrot_pass_args(interp, ctx, caller_ctx, interp->current_returns,
+ Parrot_pcc_get_results(interp, caller_ctx), PARROT_PASS_RESULTS);
+ }
argc = VTABLE_elements(interp, signature);
goto OFFSET(argc + 2);
}
Modified: branches/pcc_arg_unify_2_0/tools/build/nativecall.pl
==============================================================================
--- branches/pcc_arg_unify_2_0/tools/build/nativecall.pl Fri Sep 25 10:26:56 2009 (r41475)
+++ branches/pcc_arg_unify_2_0/tools/build/nativecall.pl Fri Sep 25 11:16:44 2009 (r41476)
@@ -43,7 +43,7 @@
as_proto => "void *",
other_decl => "PMC * const final_destination = pmc_new(interp, enum_class_UnManagedStruct);",
sig_char => "P",
- ret_assign => "VTABLE_set_pointer(interp, final_destination, return_data);\n Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"P\", final_destination);",
+ ret_assign => "VTABLE_set_pointer(interp, final_destination, return_data); set_nci_P(interp, &st, final_destination);",
},
i => { as_proto => "int", sig_char => "I" },
l => { as_proto => "long", sig_char => "I" },
@@ -53,7 +53,7 @@
d => { as_proto => "double", sig_char => "N" },
t => { as_proto => "char *",
other_decl => "STRING *final_destination;",
- ret_assign => "final_destination = Parrot_str_new(interp, return_data, 0);\n Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"S\", final_destination);",
+ ret_assign => "final_destination = Parrot_str_new(interp, return_data, 0);\n set_nci_S(interp, &st, final_destination);",
sig_char => "S" },
v => { as_proto => "void",
return_type => "void *",
@@ -71,11 +71,11 @@
B => { as_proto => "char **", as_return => "", sig_char => "S" },
# These should be replaced by modifiers in the future
2 => { as_proto => "short *", sig_char => "P", return_type => "short",
- ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' },
+ ret_assign => "set_nci_I(interp, &st, *return_data);" },
3 => { as_proto => "int *", sig_char => "P", return_type => "int",
- ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' },
+ ret_assign => "set_nci_I(interp, &st, *return_data);" },
4 => { as_proto => "long *", sig_char => "P", return_type => "long",
- ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' },
+ ret_assign => "set_nci_I(interp, &st, *return_data);" },
L => { as_proto => "long *", as_return => "" },
T => { as_proto => "char **", as_return => "" },
V => { as_proto => "void **", as_return => "", sig_char => "P" },
@@ -87,8 +87,7 @@
if (not exists $_->{return_type}) { $_->{return_type} = $_->{as_proto} }
if (not exists $_->{return_type_decl}) { $_->{return_type_decl} = $_->{return_type} }
if (not exists $_->{ret_assign} and exists $_->{sig_char}) {
- $_->{ret_assign} = 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "'
- . $_->{sig_char} . '", return_data);';
+ $_->{ret_assign} = "set_nci_".$_->{sig_char}."(interp, &st, return_data);";
}
if (not exists $_->{func_call_assign}) {
$_->{func_call_assign} = "return_data = "
@@ -121,7 +120,6 @@
next;
}
- my @fill_params;
my @extra_preamble;
my @extra_postamble;
my @temps;
@@ -134,8 +132,8 @@
die "Invalid argument signature char '$_' on line $. of $ARGV"
unless exists $sig_table{$_}{sig_char};
push @arg,
- make_arg( $_, $reg_num++, \$temp_cnt, \@temps, \@fill_params,
- \@extra_preamble, \@extra_postamble );
+ make_arg( $_, $reg_num++, \$temp_cnt, \@temps, \@extra_preamble,
+ \@extra_postamble );
$sig .= $sig_table{$_}{sig_char};
$_ eq 'J' && $reg_num--;
}
@@ -150,7 +148,7 @@
$ret_sig->{as_return}, $ret_sig->{return_type_decl},
$ret_sig->{func_call_assign}, $ret_sig->{other_decl},
$ret_sig->{ret_assign}, \@temps,
- \@fill_params, \@extra_preamble, \@extra_postamble,
+ \@extra_preamble, \@extra_postamble,
\@put_pointer_nci_too,
);
}
@@ -161,7 +159,7 @@
$ret_sig->{as_return}, $ret_sig->{return_type_decl},
$ret_sig->{func_call_assign}, $ret_sig->{other_decl},
$ret_sig->{ret_assign}, \@temps,
- \@fill_params, \@extra_preamble, \@extra_postamble,
+ \@extra_preamble, \@extra_postamble,
\@put_pointer,
);
}
@@ -203,7 +201,7 @@
*/
/* nci.c
- * Copyright (C) 2001-2009, Parrot Foundation.
+ * Copyright (C) 2001-2007, Parrot Foundation.
* SVN Info
* \$Id\$
* Overview:
@@ -248,78 +246,55 @@
# we have to fetch all to temps, so that the call code
# can operate in sequence
#
- my ( $argtype, $reg_num, $temp_cnt_ref, $temps_ref, $fill_params_ref, $extra_preamble_ref, $extra_postamble_ref )
+ my ( $argtype, $reg_num, $temp_cnt_ref, $temps_ref, $extra_preamble_ref, $extra_postamble_ref )
= @_;
local $_ = $argtype;
my $temp_num = ${$temp_cnt_ref}++;
/p/ && do {
- push @{$temps_ref}, "PMC *t_$temp_num;";
- push @{$fill_params_ref}, "&t_$temp_num";
- return "VTABLE_get_pointer(interp, t_$temp_num)";
+ push @{$temps_ref}, "void *t_$temp_num;";
+ push @{$extra_preamble_ref}, "t_$temp_num = GET_NCI_p($reg_num);";
+ return "t_$temp_num";
};
/V/ && do {
push @{$temps_ref}, "PMC *t_$temp_num;";
push @{$temps_ref}, "void *v_$temp_num;";
- push @{$fill_params_ref}, "&t_$temp_num";
+ push @{$extra_preamble_ref}, "t_$temp_num = GET_NCI_P($reg_num);";
push @{$extra_preamble_ref}, "v_$temp_num = VTABLE_get_pointer(interp, t_$temp_num);";
push @{$extra_postamble_ref}, "VTABLE_set_pointer(interp, t_$temp_num, v_$temp_num);";
return "&v_$temp_num";
};
- /[INS]/ && do {
- my $ret_type = $sig_table{$_}{return_type};
- push @{$temps_ref}, "$ret_type t_$temp_num;";
- push @{$fill_params_ref}, "&t_$temp_num";
- return "t_$temp_num";
- };
- /[ilcs]/ && do {
- my $ret_type = $sig_table{$_}{return_type};
- push @{$temps_ref}, "$ret_type t_$temp_num;";
- push @{$temps_ref}, "INTVAL ti_$temp_num;";
- push @{$fill_params_ref}, "&ti_$temp_num";
- push @{$extra_preamble_ref}, "t_$temp_num = ($ret_type)ti_$temp_num;";
- return "t_$temp_num";
- };
- /[fd]/ && do {
+ /[ilIscfdNS]/ && do {
my $ret_type = $sig_table{$_}{return_type};
push @{$temps_ref}, "$ret_type t_$temp_num;";
- push @{$temps_ref}, "FLOATVAL tf_$temp_num;";
- push @{$fill_params_ref}, "&tf_$temp_num";
- push @{$extra_preamble_ref}, "t_$temp_num = ($ret_type)tf_$temp_num;";
+ push @{$extra_preamble_ref}, "t_$temp_num = ($ret_type)GET_NCI_$sig_table{$_}{sig_char}($reg_num);";
return "t_$temp_num";
};
/[234]/ && do {
my $ret_type = $sig_table{$_}{return_type};
push @{$temps_ref}, "PMC *t_$temp_num;";
push @{$temps_ref}, "$ret_type i_$temp_num;";
- push @{$fill_params_ref}, "&t_$temp_num";
+ push @{$extra_preamble_ref}, "t_$temp_num = GET_NCI_P($reg_num);";
push @{$extra_preamble_ref}, "i_$temp_num = ($ret_type) VTABLE_get_integer(interp, t_$temp_num);";
push @{$extra_postamble_ref}, "VTABLE_set_integer_native(interp, t_$temp_num, i_$temp_num);";
return "&i_$temp_num";
};
/t/ && do {
- push @{$temps_ref}, "char *t_$temp_num;";
- push @{$temps_ref}, "STRING *ts_$temp_num;";
- push @{$fill_params_ref}, "&ts_$temp_num";
+ push @{$temps_ref}, "char *t_$temp_num;";
push @{$extra_preamble_ref},
- "t_$temp_num = ts_$temp_num ? Parrot_str_to_cstring(interp, ts_$temp_num) : (char *) NULL;";
+ "{STRING * s= GET_NCI_S($reg_num); t_$temp_num = s ? Parrot_str_to_cstring(interp, s) : (char *) NULL;}";
push @{$extra_postamble_ref}, "do { if (t_$temp_num) Parrot_str_free_cstring(t_$temp_num); } while (0);";
return "t_$temp_num";
};
/b/ && do {
push @{$temps_ref}, "STRING *t_$temp_num;";
- push @{$fill_params_ref}, "&t_$temp_num";
- return "PObj_bufstart(t_$temp_num)";
+ push @{$extra_preamble_ref}, "t_$temp_num = GET_NCI_S($reg_num);";
+ return "Buffer_bufstart(t_$temp_num)";
};
/B/ && do {
- push @{$temps_ref}, "char *s_$temp_num;";
- push @{$temps_ref}, "char *t_$temp_num;";
- push @{$temps_ref}, "void** v_$temp_num = (void **) &t_$temp_num;";
- push @{$temps_ref}, "STRING *ts_$temp_num;";
- push @{$fill_params_ref}, "&ts_$temp_num";
+ push @{$temps_ref}, "char *s_$temp_num;\n char *t_$temp_num;\n char** v_$temp_num = &t_$temp_num;";
push @{$extra_preamble_ref},
- "t_$temp_num = ts_$temp_num ? Parrot_str_to_cstring(interp, ts_$temp_num) : (char *) NULL;";
- push @{$extra_preamble_ref}, "s_$temp_num = t_$temp_num;";
+ "{STRING * s= GET_NCI_S($reg_num); t_$temp_num = s ? Parrot_str_to_cstring(interp, s) : (char *) NULL; s_$temp_num = t_$temp_num;}";
push @{$extra_postamble_ref}, "do { if (s_$temp_num) Parrot_str_free_cstring(s_$temp_num); } while (0);";
return "v_$temp_num";
};
@@ -327,19 +302,19 @@
return "interp";
};
/[OP\@]/ && do {
- push @{$temps_ref}, "PMC *t_$temp_num;";
- push @{$fill_params_ref}, "&t_$temp_num";
- return "PMC_IS_NULL(t_$temp_num) ? NULL : t_$temp_num";
+ push @{$temps_ref}, "PMC *t_$temp_num;";
+ push @{$extra_preamble_ref}, "t_$temp_num = GET_NCI_P($reg_num);";
+ return "t_$temp_num";
};
return;
}
sub create_function {
my (
- $sig, $return, $params, $args,
- $ret_type, $ret_type_decl, $return_assign, $other_decl,
- $final_assign, $temps_ref, $fill_params_ref, $extra_preamble_ref,
- $extra_postamble_ref, $put_pointer_ref,
+ $sig, $return, $params, $args,
+ $ret_type, $ret_type_decl, $return_assign, $other_decl,
+ $final_assign, $temps_ref, $extra_preamble_ref, $extra_postamble_ref,
+ $put_pointer_ref,
) = @_;
my $func = '';
@@ -347,10 +322,10 @@
$other_decl ||= "";
$other_decl .= join( "\n ", @{$temps_ref} );
- my $call_object_decl = 'PMC *call_object;';
- my $extra_preamble = join( "\n ", @{$extra_preamble_ref} );
- my $extra_postamble = join( "\n ", @{$extra_postamble_ref} );
- my $return_data_decl =
+ my $call_state = 'call_state st;';
+ my $extra_preamble = join( "\n ", @{$extra_preamble_ref} );
+ my $extra_postamble = join( "\n ", @{$extra_postamble_ref} );
+ my $return_data =
"$return_assign $final_assign" =~ /return_data/
? qq{$ret_type_decl return_data;}
: q{};
@@ -360,8 +335,6 @@
my $proto = join ', ', map { $sig_table{$_}{as_proto} } split( m//, $params );
my $call_params = join( ",", @$args );
- my $fill_params = join( ", ", @$fill_params_ref );
- $fill_params = ", " . $fill_params if($fill_params);
$func = <<"HEADER";
static void
@@ -370,10 +343,10 @@
typedef $ret_type (*func_t)($proto);
func_t pointer;
void *orig_func;
- $call_object_decl
- $return_data_decl
+ $call_state
+ $return_data
$other_decl
- Parrot_pcc_fill_params_from_c_args(interp, call_object, \"$sig\"$fill_params);
+ Parrot_init_arg_nci(interp, &st, \"$sig\");
$extra_preamble
GETATTR_NCI_orig_func(interp, self, orig_func);
@@ -387,15 +360,17 @@
else {
# Things are more simple, when there are no params
+ # call state var not needed if there are no params and a void return
+ $call_state = '' if 'v' eq $return;
$func = <<"HEADER";
static void
pcf_${return}_(PARROT_INTERP, PMC *self)
{
$ret_type (*pointer)(void);
void *orig_func;
- $return_data_decl
+ $return_data
$other_decl
- $call_object_decl
+ $call_state
$extra_preamble
GETATTR_NCI_orig_func(interp, self, orig_func);
More information about the parrot-commits
mailing list