[svn:parrot] r41477 - 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:55:42 UTC 2009
Author: bacek
Date: Fri Sep 25 11:55:42 2009
New Revision: 41477
URL: https://trac.parrot.org/parrot/changeset/41477
Log:
Revert "Recover more stuff from pcc_arg_unify branch." bacek-- using
diff with wrong 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 11:16:44 2009 (r41476)
+++ branches/pcc_arg_unify_2_0/compilers/imcc/pbc.c Fri Sep 25 11:55:42 2009 (r41477)
@@ -1124,9 +1124,8 @@
"add lexical '%s' to sub name '%Ss'\n",
n->name, sub->name);
- Parrot_PCCINVOKE(interp, lex_info,
- string_from_literal(interp, "declare_lex_preg"),
- "SI->", lex_name, r->color);
+ VTABLE_set_integer_keyed_str(interp, lex_info,
+ 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 11:16:44 2009 (r41476)
+++ branches/pcc_arg_unify_2_0/include/parrot/call.h Fri Sep 25 11:55:42 2009 (r41477)
@@ -35,6 +35,20 @@
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
@@ -216,6 +230,17 @@
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),
@@ -224,9 +249,62 @@
__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 *sig_obj))
+ ARGIN(PMC *call_object))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3);
@@ -351,15 +429,47 @@
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(sig_obj)
+ && PARROT_ASSERT_ARG(call_object)
#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 11:16:44 2009 (r41476)
+++ branches/pcc_arg_unify_2_0/lib/Parrot/Pmc2c/PCCMETHOD.pm Fri Sep 25 11:55:42 2009 (r41477)
@@ -79,10 +79,22 @@
our $reg_type_info = {
# s is string, ss is short string, at is arg type
- +(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, },
+ +(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, },
};
# Perl trim function to remove whitespace from the start and end of the string
@@ -110,10 +122,10 @@
=head3 C<parse_adverb_attributes>
builds and returs an adverb hash from an adverb string such as
- ":optional :optflag :slurpy"
+ ":optional :opt_flag :slurpy"
{
optional =>1,
- optflag =>1,
+ opt_flag =>1,
slurpy =>1,
}
@@ -137,6 +149,26 @@
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) = @_;
@@ -162,14 +194,11 @@
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";
}
@@ -185,8 +214,6 @@
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
@@ -206,7 +233,6 @@
last unless $matched;
}
- $qty_returns++;
$matched =~ /$signature_re/;
my ( $match, $returns ) = ( $1, $2 );
@@ -215,7 +241,7 @@
if ($returns eq 'void') {
$e->emit( <<"END", __FILE__, __LINE__ + 1 );
/*BEGIN RETURN $returns */
- goto no_return;
+ return;
/*END RETURN $returns */
END
$matched->replace( $match, $e );
@@ -223,40 +249,23 @@
}
my $goto_string = "goto ${method_name}_returns;";
- my ( $returns_n_regs_used, $returns_indexes, $returns_flags, $returns_accessors ) =
+ my ( $returns_signature, $returns_varargs ) =
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 );
- /*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
+ Parrot_pcc_fill_returns_from_c_args(interp, _call_object, "$returns_signature",
+ $returns_varargs);
+ return;
/*END RETURN $returns */
}
END
$matched->replace( $match, $e );
}
- return $regs_used, $qty_returns;
}
sub parse_p_args_string {
@@ -305,16 +314,20 @@
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 $args_indexes_a = []; # arg index into interp context
- my $args_flags_a = []; # arg flags
- my $args_accessors = "";
- my $named_names = "";
+ my $signature = "";
+ my @vararg_list = ();
+ my $varargs = "";
+ my $declarations = "";
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,
@@ -323,22 +336,25 @@
$arg->{named_name} = $named_name;
push @{ $args->[ +(REGNO_STR) ] }, $argn;
- $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' );
+ $signature .= 'Sn';
+ $declarations .= "$tis $dummy_name = CONST_STRING_GEN(interp, $named_name);\n";
+ push @vararg_list, $dummy_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 );
+ 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";
+ }
}
- 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 );
+ $varargs = join ", ", @vararg_list;
+ return ( $signature, $varargs, $declarations );
}
sub find_max_regs {
@@ -367,115 +383,53 @@
my $e = Parrot::Pmc2c::Emitter->new( $pmc->filename );
my $e_post = Parrot::Pmc2c::Emitter->new( $pmc->filename );
- # parse pccmethod parameters, then unshift the a PMC arg for the invocant
+ # parse pccmethod parameters, then unshift the 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(':object')
+ attrs => parse_adverb_attributes(':invocant')
};
+ # The invocant is already passed in the C signature, why pass it again?
- my ( $params_n_regs_used, $params_indexes, $params_flags, $params_accessors, $named_names ) =
+ my ( $params_signature, $params_varargs, $params_declarations ) =
process_pccmethod_args( $linear_args, 'arg' );
- my ( $n_regs, $qty_returns ) = rewrite_RETURNs( $self, $pmc );
+ 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 );
- 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);
- }
+ PMC *_caller_ctx, *_ctx, *_ccont, *_call_object;
- Parrot_pcc_set_continuation(interp, _ctx, _ret_cont);
- PARROT_CONTINUATION(_ret_cont)->from_ctx = _ctx;
+ _ctx = CURRENT_CONTEXT(interp);
+ _ccont = Parrot_pcc_get_continuation(interp, _ctx);
- _current_args = interp->current_args;
- interp->current_args = NULL;
+ _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);
+ { /* BEGIN PARMS SCOPE */
END
$e->emit(<<"END");
-$named_names
+$params_declarations
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 */
- {
+ if ($params_signature) {
+ $e->emit( <<"END", __FILE__, __LINE__ + 1 );
+ Parrot_pcc_fill_params_from_c_args(interp, _call_object, "$params_signature",
+ $params_varargs);
END
-
- my $method_returns = $self->name . "_returns:";
- $e_post->emit( <<"END", __FILE__, __LINE__ + 1 );
-
}
- goto no_return;
- /* END PMETHOD BODY */
-
+ $e->emit( <<"END", __FILE__, __LINE__ + 1 );
+ { /* BEGIN 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 */
- }
+ } /* END PMETHOD BODY */
+ } /* END PARAMS SCOPE */
no_return:
- PObj_live_CLEAR(_param_sig);
- PObj_live_CLEAR(_return_sig);
- Parrot_pop_context(interp);
+ return;
END
$self->return_type('void');
$self->parameters('');
@@ -541,7 +495,7 @@
$vars .= $out_vars;
my $e = Parrot::Pmc2c::Emitter->new( $pmc->filename );
- $e->emit(qq|Parrot_PCCINVOKE($fixed_params, "$signature", $vars);\n|);
+ $e->emit(qq|Parrot_pcc_invoke_method_from_c_args($fixed_params, "$signature", $vars);\n|);
$matched->replace( $match, $e );
}
@@ -625,7 +579,7 @@
flatten => 'f',
slurpy => 's',
optional => 'o',
- positional => 'p',
+ opt_flag => '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 11:16:44 2009 (r41476)
+++ branches/pcc_arg_unify_2_0/src/call/pcc.c Fri Sep 25 11:55:42 2009 (r41477)
@@ -105,18 +105,26 @@
__attribute__nonnull__(2)
FUNC_MODIFIES(*st);
-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)
+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)
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4)
- FUNC_MODIFIES(*args_sig)
- FUNC_MODIFIES(*results_sig);
+ __attribute__nonnull__(5)
+ FUNC_MODIFIES(*call_object);
static int fetch_arg_op(PARROT_INTERP, ARGMOD(call_state *st))
__attribute__nonnull__(1)
@@ -152,6 +160,18 @@
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),
@@ -185,18 +205,6 @@
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),
@@ -270,11 +278,16 @@
#define ASSERT_ARGS_convert_arg_from_str __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
&& PARROT_ASSERT_ARG(st)
-#define ASSERT_ARGS_count_signature_elements __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+#define ASSERT_ARGS_dissect_aggregate_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
- && PARROT_ASSERT_ARG(signature) \
- && PARROT_ASSERT_ARG(args_sig) \
- && PARROT_ASSERT_ARG(results_sig)
+ && 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)
#define ASSERT_ARGS_fetch_arg_op __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
&& PARROT_ASSERT_ARG(st)
@@ -294,6 +307,11 @@
&& 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) \
@@ -307,12 +325,6 @@
&& 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) \
@@ -342,6 +354,330 @@
/*
+=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)>
@@ -363,6 +699,8 @@
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);
@@ -373,6 +711,9 @@
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) {
@@ -381,7 +722,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, "results"), returns);
+ VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "returns"), returns);
}
if (in_return_sig) {
@@ -411,7 +752,7 @@
default:
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_INVALID_OPERATION,
- "Multiple Dispatch: invalid argument type %c!", type);
+ "Dispatch: invalid argument type %c!", type);
}
}
else {
@@ -427,8 +768,19 @@
VTABLE_push_string(interp, call_object, va_arg(args, STRING *));
break;
case 'P':
- VTABLE_push_pmc(interp, call_object, va_arg(args, PMC *));
+ {
+ 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;
@@ -436,23 +788,738 @@
default:
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_INVALID_OPERATION,
- "Multiple Dispatch: invalid argument type %c!", type);
+ "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);
+ /* 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;
+ }
+ }
+}
+
+/*
+
+=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);
- /* 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;
+ 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);
+ }
+
+ 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, ''));
+
+ 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);
}
@@ -2211,118 +3278,6 @@
/*
-=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)>
@@ -2480,69 +3435,86 @@
/*
-=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>.
+=item C<static void parse_signature_string(PARROT_INTERP, const char *signature,
+PMC **arg_flags, PMC **return_flags)>
-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.
+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.
=cut
*/
+PARROT_CAN_RETURN_NULL
static void
-set_context_sig_returns_varargs(PARROT_INTERP, ARGMOD(PMC *ctx),
- ARGMOD(opcode_t **indexes), ARGIN(const char *ret_x), va_list returns)
+parse_signature_string(PARROT_INTERP, ARGIN(const char *signature),
+ ARGMOD(PMC **arg_flags), ARGMOD(PMC **return_flags))
{
- ASSERT_ARGS(set_context_sig_returns_varargs)
- const char *x;
- unsigned int index = 0;
- unsigned int seen_arrow = 1;
+ 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++) {
+
+ /* 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;
+ }
- /* result_accessors perform the arg accessor function,
- * assigning the corresponding registers to the result variables */
- for (x = ret_x; x && *x; x++) {
- if (isupper((unsigned char)*x)) {
switch (*x) {
- case 'I':
- {
- INTVAL * const tmpINTVAL = va_arg(returns, INTVAL *);
- *tmpINTVAL = CTX_REG_INT(ctx, indexes[seen_arrow][index]);
- }
- break;
- case 'N':
- {
- FLOATVAL * const tmpFLOATVAL = va_arg(returns, FLOATVAL *);
- *tmpFLOATVAL = CTX_REG_NUM(ctx, indexes[seen_arrow][index]);
- }
- break;
- case 'S':
- {
- STRING ** const tmpSTRING = va_arg(returns, STRING **);
- *tmpSTRING = CTX_REG_STR(ctx, indexes[seen_arrow][index]);
- }
- break;
- case 'P':
- {
- PMC ** const tmpPMC = va_arg(returns, PMC **);
- *tmpPMC = CTX_REG_PMC(ctx, indexes[seen_arrow][index]);
- }
- break;
+ 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)) {
+ 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;
default:
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_INVALID_OPERATION,
- "Parrot_PCCINVOKE: invalid reg type %c!", *x);
+ "invalid signature string element %c!", *x);
}
}
}
- Parrot_pop_context(interp);
+ /* Store the final argument, if there was one. */
+ if (set)
+ VTABLE_push_integer(interp, current_array, flags);
}
@@ -2756,166 +3728,23 @@
ARGIN(const char *signature), ...)
{
ASSERT_ARGS(Parrot_PCCINVOKE)
-#define PCC_ARG_MAX 1024
- /* variables from PCCINVOKE impl in PCCMETHOD.pm */
- /* args INSP, returns INSP */
- INTVAL n_regs_used[] = { 0, 0, 0, 0, 0, 0, 0, 0 };
-
- /* Each of these is 8K. Do we want 16K on the stack? */
- opcode_t arg_indexes[PCC_ARG_MAX];
- opcode_t result_indexes[PCC_ARG_MAX];
-
- PMC * const args_sig = pmc_new(interp, enum_class_FixedIntegerArray);
- PMC * const results_sig = pmc_new(interp, enum_class_FixedIntegerArray);
- PMC * const ret_cont = new_ret_continuation_pmc(interp, NULL);
-
- 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);
+ 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);
- 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);
+ /* 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);
- 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);
+ /* 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);
}
/*
@@ -2958,6 +3787,7 @@
"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);
@@ -2967,7 +3797,7 @@
/*
=item C<void Parrot_pcc_invoke_from_sig_object(PARROT_INTERP, PMC *sub_obj, PMC
-*sig_obj)>
+*call_object)>
Follows the same conventions as C<Parrot_PCCINVOKE>, but the subroutine object
to invoke is passed as an argument rather than looked up by name, and the
@@ -2980,75 +3810,19 @@
PARROT_EXPORT
void
Parrot_pcc_invoke_from_sig_object(PARROT_INTERP, ARGIN(PMC *sub_obj),
- ARGIN(PMC *sig_obj))
+ ARGIN(PMC *call_object))
{
ASSERT_ARGS(Parrot_pcc_invoke_from_sig_object)
-#define PCC_ARG_MAX 1024
- /* variables from PCCINVOKE impl in PCCMETHOD.pm */
- /* args INSP, returns INSP */
- INTVAL n_regs_used[] = { 0, 0, 0, 0, 0, 0, 0, 0 };
- /* Each of these is 8K. Do we want 16K on the stack? */
- opcode_t arg_indexes[PCC_ARG_MAX] = {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;
+ opcode_t *dest;
+ 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);
- interp->current_cont = NEED_CONTINUATION;
+ Parrot_pcc_set_current_sig(interp, ctx, call_object);
Parrot_pcc_set_continuation(interp, ctx, ret_cont);
- PMC_cont(ret_cont)->from_ctx = ctx;
+ interp->current_cont = NEED_CONTINUATION;
+ PMC_cont(ret_cont)->from_ctx = ctx;
/* Invoke the function */
dest = VTABLE_invoke(interp, sub_obj, NULL);
@@ -3066,18 +3840,9 @@
runops(interp, offset);
interp->run_core = old_core;
}
-
- /* Set the return values from the subroutine's context into the
- caller's context */
- set_context_sig_returns(interp, ctx, indexes, ret_x, result_list);
-
- temporary_pmc_free(interp, args_sig);
- temporary_pmc_free(interp, results_sig);
-
- interp->current_args = save_current_args;
- interp->args_signature = save_args_signature;
- interp->current_object = save_current_object;
- Parrot_str_free_cstring(signature);
+ gc_unregister_pmc(interp, call_object);
+ Parrot_pcc_set_current_sig(interp, ctx, NULL);
+ Parrot_pop_context(interp);
}
Modified: branches/pcc_arg_unify_2_0/src/exceptions.c
==============================================================================
--- branches/pcc_arg_unify_2_0/src/exceptions.c Fri Sep 25 11:16:44 2009 (r41476)
+++ branches/pcc_arg_unify_2_0/src/exceptions.c Fri Sep 25 11:55:42 2009 (r41477)
@@ -38,24 +38,16 @@
__attribute__nonnull__(3);
PARROT_CAN_RETURN_NULL
-static opcode_t * pass_exception_args(PARROT_INTERP,
- ARGIN(const char *sig),
- ARGIN(opcode_t *dest),
- ARGIN(PMC * old_ctx),
- ...)
+static void pass_exception_args(PARROT_INTERP, ARGIN(const char *sig), ...)
__attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4);
+ __attribute__nonnull__(2);
#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(dest) \
- && PARROT_ASSERT_ARG(old_ctx)
+ && PARROT_ASSERT_ARG(sig)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
@@ -240,20 +232,7 @@
}
address = VTABLE_invoke(interp, handler, dest);
-
- /* 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);
+ pass_exception_args(interp, "P", exception);
if (PObj_get_FLAGS(handler) & SUB_FLAG_C_HANDLER) {
/* it's a C exception handler */
@@ -267,8 +246,7 @@
/*
-=item C<static opcode_t * pass_exception_args(PARROT_INTERP, const char *sig,
-opcode_t *dest, PMC * old_ctx, ...)>
+=item C<static void pass_exception_args(PARROT_INTERP, const char *sig, ...)>
Passes arguments to the exception handler routine. These are retrieved with
the .get_results() directive in PIR code.
@@ -278,19 +256,20 @@
*/
PARROT_CAN_RETURN_NULL
-static opcode_t *
-pass_exception_args(PARROT_INTERP, ARGIN(const char *sig),
- ARGIN(opcode_t *dest), ARGIN(PMC * old_ctx), ...)
+static void
+pass_exception_args(PARROT_INTERP, ARGIN(const char *sig), ...)
{
ASSERT_ARGS(pass_exception_args)
- va_list ap;
- opcode_t *next;
+ 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_start(ap, old_ctx);
- next = parrot_pass_args_fromc(interp, sig, dest, old_ctx, ap);
- va_end(ap);
+ CALLSIGNATURE_is_exception_SET(sig_obj);
- return next;
+ CONTEXT(interp)->current_sig = sig_obj;
}
/*
@@ -380,6 +359,7 @@
/* 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 =
@@ -389,11 +369,10 @@
/* Run the handler. */
address = VTABLE_invoke(interp, handler, NULL);
- if (PARROT_CONTINUATION(handler)->current_results)
- address = pass_exception_args(interp, "P", address,
- CURRENT_CONTEXT(interp), exception);
+ pass_exception_args(interp, "P", 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 11:16:44 2009 (r41476)
+++ branches/pcc_arg_unify_2_0/src/ops/core.ops Fri Sep 25 11:55:42 2009 (r41477)
@@ -516,93 +516,75 @@
op set_args(inconst PMC) :flow {
- opcode_t * const _this = CUR_OPCODE;
+ opcode_t * const raw_args = CUR_OPCODE;
PMC * const signature = $1;
INTVAL argc;
- /* for now just point to the opcode */
- interp->current_args = _this;
+ CONTEXT(interp)->current_sig =
+ Parrot_pcc_build_sig_object_from_op(interp,
+ PMCNULL, signature, raw_args);
+
argc = VTABLE_elements(interp, signature);
goto OFFSET(argc + 2);
}
op get_results(inconst PMC) :flow {
- opcode_t * const _this = CUR_OPCODE;
+ opcode_t * const raw_returns = CUR_OPCODE;
PMC * const signature = $1;
INTVAL argc;
- Parrot_pcc_set_results(interp, CURRENT_CONTEXT(interp), _this);
+ 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));
+
argc = VTABLE_elements(interp, signature);
goto OFFSET(argc + 2);
}
op get_params(inconst PMC) :flow {
- opcode_t * const _this = CUR_OPCODE;
+ opcode_t * const raw_params = CUR_OPCODE;
PMC *caller_ctx, *ctx;
- PMC * ccont;
+ PMC *ccont, *call_object;
PMC * const signature = $1;
INTVAL argc;
- opcode_t *src_indexes, *dst_indexes;
- interp->current_params = _this;
- ctx = CURRENT_CONTEXT(interp);
- ccont = Parrot_pcc_get_continuation(interp, ctx);
+ ctx = CURRENT_CONTEXT(interp);
+ ccont = Parrot_pcc_get_continuation(interp, ctx);
- caller_ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
+ caller_ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
+ call_object = Parrot_pcc_get_current_sig(interp, caller_ctx);
- 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_pcc_fill_params_from_op(interp, call_object, signature, raw_params);
- 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 _this = CUR_OPCODE;
+ opcode_t * const raw_returns = CUR_OPCODE;
PMC *ctx, *caller_ctx;
- PMC *ccont;
+ PMC *ccont, *call_object;
PMC *signature = $1;
INTVAL argc;
- opcode_t *src_indexes, *dest_indexes;
- 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);
- }
+ 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);
- 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 11:16:44 2009 (r41476)
+++ branches/pcc_arg_unify_2_0/tools/build/nativecall.pl Fri Sep 25 11:55:42 2009 (r41477)
@@ -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); set_nci_P(interp, &st, final_destination);",
+ ret_assign => "VTABLE_set_pointer(interp, final_destination, return_data);\n Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"P\", 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 set_nci_S(interp, &st, 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);",
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 => "set_nci_I(interp, &st, *return_data);" },
+ ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' },
3 => { as_proto => "int *", sig_char => "P", return_type => "int",
- ret_assign => "set_nci_I(interp, &st, *return_data);" },
+ ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' },
4 => { as_proto => "long *", sig_char => "P", return_type => "long",
- ret_assign => "set_nci_I(interp, &st, *return_data);" },
+ ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' },
L => { as_proto => "long *", as_return => "" },
T => { as_proto => "char **", as_return => "" },
V => { as_proto => "void **", as_return => "", sig_char => "P" },
@@ -87,7 +87,8 @@
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} = "set_nci_".$_->{sig_char}."(interp, &st, return_data);";
+ $_->{ret_assign} = 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "'
+ . $_->{sig_char} . '", return_data);';
}
if (not exists $_->{func_call_assign}) {
$_->{func_call_assign} = "return_data = "
@@ -120,6 +121,7 @@
next;
}
+ my @fill_params;
my @extra_preamble;
my @extra_postamble;
my @temps;
@@ -132,8 +134,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, \@extra_preamble,
- \@extra_postamble );
+ make_arg( $_, $reg_num++, \$temp_cnt, \@temps, \@fill_params,
+ \@extra_preamble, \@extra_postamble );
$sig .= $sig_table{$_}{sig_char};
$_ eq 'J' && $reg_num--;
}
@@ -148,7 +150,7 @@
$ret_sig->{as_return}, $ret_sig->{return_type_decl},
$ret_sig->{func_call_assign}, $ret_sig->{other_decl},
$ret_sig->{ret_assign}, \@temps,
- \@extra_preamble, \@extra_postamble,
+ \@fill_params, \@extra_preamble, \@extra_postamble,
\@put_pointer_nci_too,
);
}
@@ -159,7 +161,7 @@
$ret_sig->{as_return}, $ret_sig->{return_type_decl},
$ret_sig->{func_call_assign}, $ret_sig->{other_decl},
$ret_sig->{ret_assign}, \@temps,
- \@extra_preamble, \@extra_postamble,
+ \@fill_params, \@extra_preamble, \@extra_postamble,
\@put_pointer,
);
}
@@ -201,7 +203,7 @@
*/
/* nci.c
- * Copyright (C) 2001-2007, Parrot Foundation.
+ * Copyright (C) 2001-2009, Parrot Foundation.
* SVN Info
* \$Id\$
* Overview:
@@ -246,55 +248,78 @@
# 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, $extra_preamble_ref, $extra_postamble_ref )
+ my ( $argtype, $reg_num, $temp_cnt_ref, $temps_ref, $fill_params_ref, $extra_preamble_ref, $extra_postamble_ref )
= @_;
local $_ = $argtype;
my $temp_num = ${$temp_cnt_ref}++;
/p/ && do {
- push @{$temps_ref}, "void *t_$temp_num;";
- push @{$extra_preamble_ref}, "t_$temp_num = GET_NCI_p($reg_num);";
- return "t_$temp_num";
+ push @{$temps_ref}, "PMC *t_$temp_num;";
+ push @{$fill_params_ref}, "&t_$temp_num";
+ return "VTABLE_get_pointer(interp, t_$temp_num)";
};
/V/ && do {
push @{$temps_ref}, "PMC *t_$temp_num;";
push @{$temps_ref}, "void *v_$temp_num;";
- push @{$extra_preamble_ref}, "t_$temp_num = GET_NCI_P($reg_num);";
+ push @{$fill_params_ref}, "&t_$temp_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";
};
- /[ilIscfdNS]/ && do {
+ /[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 {
my $ret_type = $sig_table{$_}{return_type};
push @{$temps_ref}, "$ret_type t_$temp_num;";
- push @{$extra_preamble_ref}, "t_$temp_num = ($ret_type)GET_NCI_$sig_table{$_}{sig_char}($reg_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;";
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 @{$extra_preamble_ref}, "t_$temp_num = GET_NCI_P($reg_num);";
+ push @{$fill_params_ref}, "&t_$temp_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}, "char *t_$temp_num;";
+ push @{$temps_ref}, "STRING *ts_$temp_num;";
+ push @{$fill_params_ref}, "&ts_$temp_num";
push @{$extra_preamble_ref},
- "{STRING * s= GET_NCI_S($reg_num); t_$temp_num = s ? Parrot_str_to_cstring(interp, s) : (char *) NULL;}";
+ "t_$temp_num = ts_$temp_num ? Parrot_str_to_cstring(interp, ts_$temp_num) : (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 @{$extra_preamble_ref}, "t_$temp_num = GET_NCI_S($reg_num);";
- return "Buffer_bufstart(t_$temp_num)";
+ push @{$fill_params_ref}, "&t_$temp_num";
+ return "PObj_bufstart(t_$temp_num)";
};
/B/ && do {
- push @{$temps_ref}, "char *s_$temp_num;\n char *t_$temp_num;\n char** v_$temp_num = &t_$temp_num;";
+ 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 @{$extra_preamble_ref},
- "{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;}";
+ "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;";
push @{$extra_postamble_ref}, "do { if (s_$temp_num) Parrot_str_free_cstring(s_$temp_num); } while (0);";
return "v_$temp_num";
};
@@ -302,19 +327,19 @@
return "interp";
};
/[OP\@]/ && do {
- push @{$temps_ref}, "PMC *t_$temp_num;";
- push @{$extra_preamble_ref}, "t_$temp_num = GET_NCI_P($reg_num);";
- return "t_$temp_num";
+ 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";
};
return;
}
sub create_function {
my (
- $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,
+ $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,
) = @_;
my $func = '';
@@ -322,10 +347,10 @@
$other_decl ||= "";
$other_decl .= join( "\n ", @{$temps_ref} );
- 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 =
+ 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 =
"$return_assign $final_assign" =~ /return_data/
? qq{$ret_type_decl return_data;}
: q{};
@@ -335,6 +360,8 @@
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
@@ -343,10 +370,10 @@
typedef $ret_type (*func_t)($proto);
func_t pointer;
void *orig_func;
- $call_state
- $return_data
+ $call_object_decl
+ $return_data_decl
$other_decl
- Parrot_init_arg_nci(interp, &st, \"$sig\");
+ Parrot_pcc_fill_params_from_c_args(interp, call_object, \"$sig\"$fill_params);
$extra_preamble
GETATTR_NCI_orig_func(interp, self, orig_func);
@@ -360,17 +387,15 @@
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
+ $return_data_decl
$other_decl
- $call_state
+ $call_object_decl
$extra_preamble
GETATTR_NCI_orig_func(interp, self, orig_func);
More information about the parrot-commits
mailing list