[svn:parrot] r41567 - in branches/pcc_reapply: compilers/imcc config/gen/config_pm include/parrot lib/Parrot/Pmc2c src src/call src/interp src/ops src/pmc t/op t/pmc tools/build
allison at svn.parrot.org
allison at svn.parrot.org
Tue Sep 29 23:13:55 UTC 2009
Author: allison
Date: Tue Sep 29 23:13:51 2009
New Revision: 41567
URL: https://trac.parrot.org/parrot/changeset/41567
Log:
[pcc] Reapplying changes from pcc_arg_unify to fresh branch of trunk, so others
can contribute more easily.
Modified:
branches/pcc_reapply/compilers/imcc/pbc.c
branches/pcc_reapply/config/gen/config_pm/config_lib_pasm.in
branches/pcc_reapply/include/parrot/call.h
branches/pcc_reapply/include/parrot/context.h
branches/pcc_reapply/lib/Parrot/Pmc2c/PCCMETHOD.pm
branches/pcc_reapply/src/call/context.c
branches/pcc_reapply/src/call/pcc.c
branches/pcc_reapply/src/debug.c
branches/pcc_reapply/src/embed.c
branches/pcc_reapply/src/events.c
branches/pcc_reapply/src/exceptions.c
branches/pcc_reapply/src/extend.c
branches/pcc_reapply/src/hash.c
branches/pcc_reapply/src/interp/inter_cb.c
branches/pcc_reapply/src/library.c
branches/pcc_reapply/src/multidispatch.c
branches/pcc_reapply/src/ops/core.ops
branches/pcc_reapply/src/packfile.c
branches/pcc_reapply/src/pmc/callsignature.pmc
branches/pcc_reapply/src/pmc/capture.pmc
branches/pcc_reapply/src/pmc/class.pmc
branches/pcc_reapply/src/pmc/cpointer.pmc
branches/pcc_reapply/src/pmc/multisub.pmc
branches/pcc_reapply/src/pmc/nci.pmc
branches/pcc_reapply/src/pmc/object.pmc
branches/pcc_reapply/src/scheduler.c
branches/pcc_reapply/src/thread.c
branches/pcc_reapply/src/utils.c
branches/pcc_reapply/t/op/annotate.t
branches/pcc_reapply/t/op/calling.t
branches/pcc_reapply/t/pmc/capture.t
branches/pcc_reapply/t/pmc/resizablestringarray.t
branches/pcc_reapply/tools/build/nativecall.pl
Modified: branches/pcc_reapply/compilers/imcc/pbc.c
==============================================================================
--- branches/pcc_reapply/compilers/imcc/pbc.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/compilers/imcc/pbc.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -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_reapply/config/gen/config_pm/config_lib_pasm.in
==============================================================================
--- branches/pcc_reapply/config/gen/config_pm/config_lib_pasm.in Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/config/gen/config_pm/config_lib_pasm.in Tue Sep 29 23:13:51 2009 (r41567)
@@ -11,7 +11,7 @@
set I11, 1 # install flag
no_arg:
new P0, 'Hash'
- new P1, 'Undef'
+ null P1
@PCONFIG@
Modified: branches/pcc_reapply/include/parrot/call.h
==============================================================================
--- branches/pcc_reapply/include/parrot/call.h Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/include/parrot/call.h Tue Sep 29 23:13:51 2009 (r41567)
@@ -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) \
@@ -688,6 +798,60 @@
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: src/call/ops.c */
+/* HEADERIZER BEGIN: src/call/callsignature.c */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+opcode_t* Parrot_pcc_get_call_sig_raw_args(PARROT_INTERP,
+ ARGIN(PMC *call_sig))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+opcode_t* Parrot_pcc_get_call_sig_raw_returns(PARROT_INTERP,
+ ARGIN(PMC *call_sig))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+void Parrot_pcc_set_call_sig_raw_args(PARROT_INTERP,
+ ARGIN(PMC *call_sig),
+ ARGIN_NULLOK(opcode_t *raw_args))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+void Parrot_pcc_set_call_sig_raw_returns(PARROT_INTERP,
+ ARGIN(PMC *call_sig),
+ ARGIN_NULLOK(opcode_t *raw_returns))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+#define ASSERT_ARGS_Parrot_pcc_get_call_sig_raw_args \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(call_sig)
+#define ASSERT_ARGS_Parrot_pcc_get_call_sig_raw_returns \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(call_sig)
+#define ASSERT_ARGS_Parrot_pcc_set_call_sig_raw_args \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(call_sig)
+#define ASSERT_ARGS_Parrot_pcc_set_call_sig_raw_returns \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(call_sig)
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: src/call/callsignature.c */
+
#define ASSERT_SIG_PMC(sig) do {\
PARROT_ASSERT(!PMC_IS_NULL(sig)); \
PARROT_ASSERT(PObj_is_PMC_TEST(sig)); \
@@ -899,6 +1063,12 @@
PARROT_EXPORT
PARROT_CAN_RETURN_NULL
+PMC* Parrot_pcc_get_signature(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
STRING* Parrot_pcc_get_string_constant(PARROT_INTERP,
ARGIN(PMC *ctx),
INTVAL idx)
@@ -1045,6 +1215,13 @@
__attribute__nonnull__(2);
PARROT_EXPORT
+void Parrot_pcc_set_signature(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ ARGIN_NULLOK(PMC *sig_object))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
void Parrot_pcc_set_sub(PARROT_INTERP,
ARGIN(PMC *ctx),
ARGIN_NULLOK(PMC *sub))
@@ -1218,6 +1395,9 @@
__attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(ctx))
+#define ASSERT_ARGS_Parrot_pcc_get_signature __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(ctx))
#define ASSERT_ARGS_Parrot_pcc_get_string_constant \
__attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
@@ -1287,6 +1467,9 @@
__attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(ctx))
+#define ASSERT_ARGS_Parrot_pcc_set_signature __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(ctx))
#define ASSERT_ARGS_Parrot_pcc_set_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(ctx))
Modified: branches/pcc_reapply/include/parrot/context.h
==============================================================================
--- branches/pcc_reapply/include/parrot/context.h Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/include/parrot/context.h Tue Sep 29 23:13:51 2009 (r41567)
@@ -111,6 +111,8 @@
INTVAL current_HLL; /* see also src/hll.c */
+ PMC *caller_sig; /* CallSignature PMC that invoked this context*/
+ PMC *current_sig; /* temporary CallSignature PMC for active call */
UINTVAL warns; /* Keeps track of what warnings
* have been activated */
UINTVAL errors; /* fatals that can be turned off */
Modified: branches/pcc_reapply/lib/Parrot/Pmc2c/PCCMETHOD.pm
==============================================================================
--- branches/pcc_reapply/lib/Parrot/Pmc2c/PCCMETHOD.pm Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/lib/Parrot/Pmc2c/PCCMETHOD.pm Tue Sep 29 23:13:51 2009 (r41567)
@@ -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,55 @@
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')
};
- my ( $params_n_regs_used, $params_indexes, $params_flags, $params_accessors, $named_names ) =
+ # The invocant is already passed in the C signature, why pass it again?
+
+ 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;
+ PMC *_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_signature(interp, _ctx);
+ Parrot_pcc_set_signature(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 +497,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 +581,7 @@
flatten => 'f',
slurpy => 's',
optional => 'o',
- positional => 'p',
+ opt_flag => 'p',
);
my @arg_names = ($name);
Modified: branches/pcc_reapply/src/call/context.c
==============================================================================
--- branches/pcc_reapply/src/call/context.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/call/context.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -592,6 +592,45 @@
/*
+=item C<PMC* Parrot_pcc_get_signature(PARROT_INTERP, PMC *ctx)>
+
+Get call signature object of Context (in sub/method call).
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC*
+Parrot_pcc_get_signature(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_signature)
+ Parrot_Context const *c = get_context_struct_fast(interp, ctx);
+ return c->current_sig;
+}
+
+/*
+
+=item C<void Parrot_pcc_set_signature(PARROT_INTERP, PMC *ctx, PMC *sig_object)>
+
+Set signature of Context (in sub/method call).
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_set_signature(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN_NULLOK(PMC *sig_object))
+{
+ ASSERT_ARGS(Parrot_pcc_set_signature)
+ Parrot_Context *c = get_context_struct_fast(interp, ctx);
+ c->current_sig = sig_object;
+}
+
+/*
+
=item C<PMC* Parrot_pcc_get_object(PARROT_INTERP, PMC *ctx)>
Get object of Context (in method call).
Modified: branches/pcc_reapply/src/call/pcc.c
==============================================================================
--- branches/pcc_reapply/src/call/pcc.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/call/pcc.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -118,6 +118,27 @@
FUNC_MODIFIES(*args_sig)
FUNC_MODIFIES(*results_sig);
+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)
+ __attribute__nonnull__(5)
+ FUNC_MODIFIES(*call_object);
+
static int fetch_arg_op(PARROT_INTERP, ARGMOD(call_state *st))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
@@ -152,6 +173,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),
@@ -275,6 +308,16 @@
, PARROT_ASSERT_ARG(signature) \
, PARROT_ASSERT_ARG(args_sig) \
, PARROT_ASSERT_ARG(results_sig))
+#define ASSERT_ARGS_dissect_aggregate_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(call_object) \
+ , PARROT_ASSERT_ARG(aggregate))
+#define ASSERT_ARGS_extract_named_arg_from_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(call_object) \
+ , PARROT_ASSERT_ARG(name) \
+ , PARROT_ASSERT_ARG(raw_sig) \
+ , PARROT_ASSERT_ARG(raw_args))
#define ASSERT_ARGS_fetch_arg_op __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(st))
@@ -294,6 +337,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) \
@@ -342,6 +390,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 +735,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);
@@ -372,90 +746,819 @@
if (!sig_len)
return call_object;
- VTABLE_set_string_native(interp, call_object, string_sig);
+ 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) {
+ const INTVAL type = Parrot_str_indexed(interp, string_sig, i);
+
+ /* Only create the returns array if it's needed */
+ if (in_return_sig && PMC_IS_NULL(returns)) {
+ returns = pmc_new(interp, enum_class_ResizablePMCArray);
+ VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "returns"), returns);
+ }
+
+ if (in_return_sig) {
+ STRING * const signature = CONST_STRING(interp, "signature");
+ /* Returns store the original passed-in pointer so they can pass
+ * the result back to the caller. */
+ PMC * const val_pointer = pmc_new(interp, enum_class_CPointer);
+ VTABLE_push_pmc(interp, returns, val_pointer);
+
+ switch (type) {
+ case 'I':
+ VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, INTVAL *));
+ VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "I"));
+ break;
+ case 'N':
+ VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, FLOATVAL *));
+ VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "N"));
+ break;
+ case 'S':
+ VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, STRING **));
+ VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "S"));
+ break;
+ case 'P':
+ VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, PMC **));
+ VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "P"));
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "Dispatch: invalid argument type %c!", type);
+ }
+ }
+ else {
+ /* Regular arguments just set the value */
+ switch (type) {
+ case 'I':
+ VTABLE_push_integer(interp, call_object, va_arg(args, INTVAL));
+ break;
+ case 'N':
+ VTABLE_push_float(interp, call_object, va_arg(args, FLOATVAL));
+ break;
+ case 'S':
+ VTABLE_push_string(interp, call_object, va_arg(args, STRING *));
+ break;
+ case 'P':
+ {
+ 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;
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "Dispatch: invalid argument type %c!", type);
+ }
+ }
+ }
+
+ /* Check if we have an invocant, and add it to the front of the arguments */
+ if (!PMC_IS_NULL(obj)) {
+ string_sig = Parrot_str_concat(interp, CONST_STRING(interp, "Pi"), string_sig, 0);
+ VTABLE_set_string_native(interp, call_object, string_sig);
+ VTABLE_unshift_pmc(interp, call_object, obj);
+ }
+
+ /* Build a type_tuple for multiple dispatch */
+ type_tuple = Parrot_mmd_build_type_tuple_from_sig_obj(interp, call_object);
+ VTABLE_set_pmc(interp, call_object, type_tuple);
+
+ return call_object;
+}
+
+/*
+
+=item C<void Parrot_pcc_fill_params_from_op(PARROT_INTERP, PMC *call_object, PMC
+*raw_sig, opcode_t *raw_params)>
+
+Gets args for the current function call and puts them into position.
+First it gets the positional non-slurpy parameters, then the positional
+slurpy parameters, then the named parameters, and finally the named
+slurpy parameters.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_fill_params_from_op(PARROT_INTERP, ARGMOD(PMC *call_object),
+ ARGIN(PMC *raw_sig), ARGIN(opcode_t *raw_params))
+{
+ ASSERT_ARGS(Parrot_pcc_fill_params_from_op)
+ PMC *ctx = CURRENT_CONTEXT(interp);
+ INTVAL positional_elements = VTABLE_elements(interp, call_object);
+ INTVAL param_count = VTABLE_elements(interp, raw_sig);
+ STRING *param_name = NULL;
+ INTVAL param_index = 0;
+ INTVAL positional_index = 0;
+ INTVAL named_count = 0;
+ INTVAL slurpy_count = 0;
+ INTVAL optional_count = 0;
+ INTVAL err_check = 0;
+ INTVAL got_optional = -1;
+
+ /* Check if we should be throwing errors. This is configured separately
+ * for parameters and return values. */
+ if (PARROT_ERRORS_test(interp, PARROT_ERRORS_PARAM_COUNT_FLAG))
+ err_check = 1;
+
+ for (param_index = 0; param_index < param_count; param_index++) {
+ INTVAL param_flags = VTABLE_get_integer_keyed_int(interp,
+ raw_sig, param_index);
+
+ const INTVAL raw_index = raw_params[param_index + 2];
+
+ /* opt_flag parameter */
+ if (param_flags & PARROT_ARG_OPT_FLAG) {
+ if (optional_count <= 0)
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "optional flag with no optional parameter");
+ if (got_optional < 0 || got_optional > 1)
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "unable to determine if optional argument was passed");
+
+ CTX_REG_INT(ctx, raw_index) = got_optional;
+ got_optional = -1;
+ continue; /* on to next parameter */
+ }
+ /* Collected ("slurpy") parameter */
+ else if (param_flags & PARROT_ARG_SLURPY_ARRAY) {
+ /* Collect named arguments into hash */
+ if (param_flags & PARROT_ARG_NAME) {
+ PMC * const collect_named = pmc_new(interp,
+ Parrot_get_ctx_HLL_type(interp, enum_class_Hash));
+
+ CTX_REG_PMC(ctx, raw_index) = collect_named;
+ named_count += VTABLE_elements(interp, collect_named);
+ }
+ /* Collect positional arguments into array */
+ else {
+ PMC *collect_positional;
+ if (named_count > 0)
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "named parameters must follow all positional parameters");
+ collect_positional = pmc_new(interp,
+ Parrot_get_ctx_HLL_type(interp, enum_class_ResizablePMCArray));
+ for (; positional_index < positional_elements; positional_index++) {
+ VTABLE_push_pmc(interp, collect_positional,
+ VTABLE_get_pmc_keyed_int(interp, call_object, positional_index));
+ }
+ CTX_REG_PMC(ctx, raw_index) = collect_positional;
+ }
+
+ continue; /* on to next parameter */
+ }
+ /* Named non-collected */
+ else if (param_flags & PARROT_ARG_NAME) {
+ /* Just store the name for now (this parameter is only the
+ * name). The next parameter is the actual value. */
+ param_name = PARROT_ARG_CONSTANT_ISSET(param_flags)
+ ? Parrot_pcc_get_string_constant(interp, ctx, raw_index)
+ : CTX_REG_STR(ctx, raw_index);
+
+ continue;
+ }
+ else if (!STRING_IS_NULL(param_name)) {
+ /* The previous parameter was a parameter name. Now set the
+ * value of the named parameter.*/
+ if (VTABLE_exists_keyed_str(interp, call_object, param_name)) {
+ named_count++;
+
+ switch (PARROT_ARG_TYPE_MASK_MASK(param_flags)) {
+ case PARROT_ARG_INTVAL:
+ CTX_REG_INT(ctx, raw_index) =
+ VTABLE_get_integer_keyed_str(interp, call_object, param_name);
+ break;
+ case PARROT_ARG_FLOATVAL:
+ CTX_REG_NUM(ctx, raw_index) =
+ VTABLE_get_number_keyed_str(interp, call_object, param_name);
+ break;
+ case PARROT_ARG_STRING:
+ CTX_REG_STR(ctx, raw_index) =
+ VTABLE_get_string_keyed_str(interp, call_object, param_name);
+ break;
+ case PARROT_ARG_PMC:
+ CTX_REG_PMC(ctx, raw_index) =
+ VTABLE_get_pmc_keyed_str(interp, call_object, param_name);
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION, "invalid parameter type");
+ break;
+ }
+ param_name = NULL;
+ continue; /* on to next parameter */
+ }
+
+ /* If the named parameter doesn't have a corresponding named
+ * argument, fall through to positional argument handling. */
+ param_name = NULL;
+ }
+
+ /* Positional non-collected */
+ if (named_count > 0)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "named parameters must follow all positional parameters");
+ if (slurpy_count > 0)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "slurpy parameters must follow ordinary positional parameters");
+
+ /* No more positional arguments available to assign */
+ if (positional_index >= positional_elements) {
+ if (!(param_flags & PARROT_ARG_OPTIONAL))
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "too few positional arguments: %d passed, %d (or more) expected",
+ positional_elements, param_index + 1);
+
+ got_optional = 0;
+ optional_count++;
+ switch (PARROT_ARG_TYPE_MASK_MASK(param_flags)) {
+ case PARROT_ARG_INTVAL:
+ CTX_REG_INT(ctx, raw_index) = 0;
+ break;
+ case PARROT_ARG_FLOATVAL:
+ CTX_REG_NUM(ctx, raw_index) = 0.0;
+ break;
+ case PARROT_ARG_STRING:
+ CTX_REG_STR(ctx, raw_index) = NULL;
+ break;
+ case PARROT_ARG_PMC:
+ CTX_REG_PMC(ctx, raw_index) = PMCNULL;
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION, "invalid parameter type");
+ break;
+ }
+
+ continue; /* on to next parameter */
+ }
+
+ /* Otherwise, we have a positional argument to assign to the
+ * positional parameter, so go ahead and assign it. */
+ if (param_flags & PARROT_ARG_OPTIONAL) {
+ got_optional = 1;
+ optional_count++;
+ }
+
+ switch (PARROT_ARG_TYPE_MASK_MASK(param_flags)) {
+ case PARROT_ARG_INTVAL:
+ CTX_REG_INT(ctx, raw_index) =
+ VTABLE_get_integer_keyed_int(interp, call_object, positional_index);
+ positional_index++;
+ break;
+ case PARROT_ARG_FLOATVAL:
+ CTX_REG_NUM(ctx, raw_index) =
+ VTABLE_get_number_keyed_int(interp, call_object, positional_index);
+ positional_index++;
+ break;
+ case PARROT_ARG_STRING:
+ CTX_REG_STR(ctx, raw_index) =
+ VTABLE_get_string_keyed_int(interp, call_object, positional_index);
+ positional_index++;
+ break;
+ case PARROT_ARG_PMC:
+ CTX_REG_PMC(ctx, raw_index) =
+ VTABLE_get_pmc_keyed_int(interp, call_object, positional_index);
+ positional_index++;
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION, "invalid parameter type");
+ break;
+ }
+ }
+
+ if (err_check && (positional_elements > positional_index))
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "too many positional arguments: %d passed, %d expected",
+ positional_elements, param_count);
+
+}
+
+/*
+
+=item C<void Parrot_pcc_fill_params_from_c_args(PARROT_INTERP, PMC *call_object,
+const char *signature, ...)>
+
+Gets args for the current function call and puts them into position.
+First it gets the positional non-slurpy parameters, then the positional
+slurpy parameters, then the named parameters, and finally the named
+slurpy parameters.
+
+The signature is a string in the format used for
+C<Parrot_pcc_invoke_from_sig_object>, but with no return arguments. The
+parameters are passed in as a list of references to the destination
+variables.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_fill_params_from_c_args(PARROT_INTERP, ARGMOD(PMC *call_object),
+ ARGIN(const char *signature), ...)
+{
+ ASSERT_ARGS(Parrot_pcc_fill_params_from_c_args)
+ va_list args;
+ PMC *ctx = CURRENT_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;
+ PMC *ctx = CURRENT_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;
- /* Process the varargs list */
- for (i = 0; i < sig_len; ++i) {
- const INTVAL type = Parrot_str_indexed(interp, string_sig, i);
+ PMC *raw_sig = PMCNULL;
+ PMC *invalid_sig = PMCNULL;
- /* 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);
- }
+ 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);
- if (in_return_sig) {
- STRING * const signature = CONST_STRING(interp, "signature");
- /* Returns store the original passed-in pointer so they can pass
- * the result back to the caller. */
- PMC * const val_pointer = pmc_new(interp, enum_class_CPointer);
- VTABLE_push_pmc(interp, returns, val_pointer);
+ /* 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;
- switch (type) {
- case 'I':
- VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, INTVAL *));
- VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "I"));
- break;
- case 'N':
- VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, FLOATVAL *));
- VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "N"));
- break;
- case 'S':
- VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, STRING **));
- VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "S"));
- break;
- case 'P':
- VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, PMC **));
- VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "P"));
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "Multiple Dispatch: invalid argument type %c!", type);
- }
- }
- else {
- /* Regular arguments just set the value */
- switch (type) {
- case 'I':
- VTABLE_push_integer(interp, call_object, va_arg(args, INTVAL));
- break;
- case 'N':
- VTABLE_push_float(interp, call_object, va_arg(args, FLOATVAL));
- break;
- case 'S':
- VTABLE_push_string(interp, call_object, va_arg(args, STRING *));
- break;
- case 'P':
- VTABLE_push_pmc(interp, call_object, va_arg(args, PMC *));
- break;
- case '-':
- i++; /* skip '>' */
- in_return_sig = 1;
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_INVALID_OPERATION,
- "Multiple Dispatch: invalid argument type %c!", type);
- }
- }
+ 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);
- /* 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);
+
+ 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);
}
- /* 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);
+ 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);
- return call_object;
+ 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);
}
+
/*
=item C<void Parrot_init_arg_nci(PARROT_INTERP, call_state *st, const char
@@ -2545,6 +3648,89 @@
Parrot_pop_context(interp);
}
+/*
+
+=item C<static void parse_signature_string(PARROT_INTERP, const char *signature,
+PMC **arg_flags, PMC **return_flags)>
+
+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
+parse_signature_string(PARROT_INTERP, ARGIN(const char *signature),
+ ARGMOD(PMC **arg_flags), ARGMOD(PMC **return_flags))
+{
+ 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;
+ }
+
+ switch (*x) {
+ case 'I': flags = PARROT_ARG_INTVAL; set++; break;
+ case 'N': flags = PARROT_ARG_FLOATVAL; set++; break;
+ case 'S': flags = PARROT_ARG_STRING; set++; break;
+ case 'P': flags = PARROT_ARG_PMC; set++; break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "invalid signature string element %c!", *x);
+ }
+
+ }
+ /* parse arg adverbs */
+ else if (islower((unsigned char)*x)) {
+ 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,
+ "invalid signature string element %c!", *x);
+ }
+ }
+ }
+
+ /* Store the final argument, if there was one. */
+ if (set)
+ VTABLE_push_integer(interp, current_array, flags);
+}
/*
@@ -2756,166 +3942,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 +4001,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 +4011,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,107 +4024,42 @@
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_signature(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);
- /* PIR Subs need runops to run their opcodes. Methods and NCI subs don't. */
+ /* PIR Subs need runops to run their opcodes. Methods and NCI subs
+ * don't. */
if (sub_obj->vtable->base_type == enum_class_Sub
- && PMC_IS_NULL(interp->current_object)) {
+ && PMC_IS_NULL(interp->current_object)) {
Parrot_runcore_t *old_core = interp->run_core;
- const opcode_t offset = dest - interp->code->base.data;
+ const opcode_t offset = dest - interp->code->base.data;
/* can't re-enter the runloop from here with PIC cores: RT #60048 */
if (PARROT_RUNCORE_PREDEREF_OPS_TEST(interp->run_core))
Parrot_runcore_switch(interp, CONST_STRING(interp, "slow"));
runops(interp, offset);
- interp->run_core = old_core;
+ Interp_core_SET(interp, 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_signature(interp, ctx, NULL);
+ Parrot_pop_context(interp);
}
-
/*
=back
Modified: branches/pcc_reapply/src/debug.c
==============================================================================
--- branches/pcc_reapply/src/debug.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/debug.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -3537,6 +3537,7 @@
STRING *str;
PMC *old = PMCNULL;
int rec_level = 0;
+ int limit_count = 0;
/* information about the current sub */
PMC *sub = interpinfo_p(interp, CURRENT_SUB);
@@ -3568,23 +3569,35 @@
/* backtrace: follow the continuation chain */
while (1) {
Parrot_Continuation_attributes *sub_cont;
+
+ /* Limit the levels dumped, no segfault on infinite recursion */
+ if (++limit_count > RECURSION_LIMIT)
+ break;
+
sub = Parrot_pcc_get_continuation(interp, ctx);
if (PMC_IS_NULL(sub))
break;
+
sub_cont = PARROT_CONTINUATION(sub);
if (!sub_cont)
break;
- str = Parrot_Context_infostr(interp, sub_cont->to_ctx);
+
+ str = Parrot_Context_infostr(interp, Parrot_pcc_get_caller_ctx(interp, ctx));
+
if (!str)
break;
+
/* recursion detection */
- if (!PMC_IS_NULL(old) && PMC_cont(old) &&
+ if (ctx == sub_cont->to_ctx) {
+ ++rec_level;
+ }
+ else if (!PMC_IS_NULL(old) && PMC_cont(old) &&
Parrot_pcc_get_pc(interp, PMC_cont(old)->to_ctx) ==
Parrot_pcc_get_pc(interp, PMC_cont(sub)->to_ctx) &&
Parrot_pcc_get_sub(interp, PMC_cont(old)->to_ctx) ==
@@ -3620,7 +3633,7 @@
}
/* get the next Continuation */
- ctx = PARROT_CONTINUATION(sub)->to_ctx;
+ ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
old = sub;
if (!ctx)
Modified: branches/pcc_reapply/src/embed.c
==============================================================================
--- branches/pcc_reapply/src/embed.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/embed.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -824,7 +824,7 @@
Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), NULL);
Parrot_pcc_set_constants(interp, interp->ctx, interp->code->const_table->constants);
- Parrot_runops_fromc_args(interp, main_sub, "vP", userargv);
+ Parrot_pcc_invoke_sub_from_c_args(interp, main_sub, "P->", userargv);
}
Modified: branches/pcc_reapply/src/events.c
==============================================================================
--- branches/pcc_reapply/src/events.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/events.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -1471,8 +1471,8 @@
break;
case EVENT_TYPE_TIMER:
/* run ops, save registers */
- Parrot_runops_fromc_args_event(interp,
- event->u.timer_event.sub, "v");
+ Parrot_pcc_invoke_sub_from_c_args(interp,
+ event->u.timer_event.sub, "->");
break;
case EVENT_TYPE_CALL_BACK:
edebug((stderr, "starting user cb\n"));
@@ -1481,9 +1481,9 @@
break;
case EVENT_TYPE_IO:
edebug((stderr, "starting io handler\n"));
- Parrot_runops_fromc_args_event(interp,
+ Parrot_pcc_invoke_sub_from_c_args(interp,
event->u.io_event.handler,
- "vPP",
+ "PP->",
event->u.io_event.pio,
event->u.io_event.user_data);
break;
Modified: branches/pcc_reapply/src/exceptions.c
==============================================================================
--- branches/pcc_reapply/src/exceptions.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/exceptions.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -48,6 +48,11 @@
__attribute__nonnull__(3)
__attribute__nonnull__(4);
+PARROT_CAN_RETURN_NULL
+static void setup_exception_args(PARROT_INTERP, ARGIN(const char *sig), ...)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
#define ASSERT_ARGS_build_exception_from_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
PARROT_ASSERT_ARG(interp) \
, PARROT_ASSERT_ARG(format))
@@ -56,6 +61,9 @@
, PARROT_ASSERT_ARG(sig) \
, PARROT_ASSERT_ARG(dest) \
, PARROT_ASSERT_ARG(old_ctx))
+#define ASSERT_ARGS_setup_exception_args __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+ PARROT_ASSERT_ARG(interp) \
+ , PARROT_ASSERT_ARG(sig))
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
@@ -240,20 +248,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);
+ setup_exception_args(interp, "P", exception);
if (PObj_get_FLAGS(handler) & SUB_FLAG_C_HANDLER) {
/* it's a C exception handler */
@@ -267,12 +262,41 @@
/*
+=item C<static void setup_exception_args(PARROT_INTERP, const char *sig, ...)>
+
+Sets up arguments to the exception handler invocation.
+
+=cut
+
+*/
+
+PARROT_CAN_RETURN_NULL
+static void
+setup_exception_args(PARROT_INTERP, ARGIN(const char *sig), ...)
+{
+ ASSERT_ARGS(setup_exception_args)
+ va_list args;
+ PMC *sig_obj;
+
+ va_start(args, sig);
+ sig_obj = Parrot_pcc_build_sig_object_from_varargs(interp, PMCNULL, sig, args);
+ va_end(args);
+
+ CALLSIGNATURE_is_exception_SET(sig_obj);
+
+ Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), sig_obj);
+}
+
+/*
+
=item C<static opcode_t * pass_exception_args(PARROT_INTERP, const char *sig,
opcode_t *dest, PMC * old_ctx, ...)>
Passes arguments to the exception handler routine. These are retrieved with
the .get_results() directive in PIR code.
+Note: DEPRECATED
+
=cut
*/
@@ -380,6 +404,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,9 +414,7 @@
/* 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);
+ setup_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_reapply/src/extend.c
==============================================================================
--- branches/pcc_reapply/src/extend.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/extend.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -1038,19 +1038,60 @@
ARGIN(const char *signature), ...)
{
ASSERT_ARGS(Parrot_call_sub)
- va_list ap;
- void *result;
- Parrot_Sub_attributes *sub;
+ va_list args;
+ PMC *sig_object;
+ void *result;
+ char return_sig = signature[0];
+ const char *arg_sig = signature;
+
+ arg_sig++;
+ va_start(args, signature);
+ sig_object = Parrot_pcc_build_sig_object_from_varargs(interp, PMCNULL, arg_sig, args);
+ va_end(args);
+
+ /* Add the return argument onto the call signature object (a bit
+ * hackish, added for backward compatibility in deprecated API function,
+ * see TT #XXX). */
+ switch (return_sig) {
+ case 'v':
+ {
+ Parrot_String full_sig = VTABLE_get_string(interp, sig_object);
+ Parrot_str_concat(interp, full_sig,
+ Parrot_str_new_constant(interp, "->"), 0);
+ break;
+ }
+ case 'V':
+ case 'P':
+ {
+ Parrot_String full_sig;
+ Parrot_PMC returns;
+ Parrot_PMC return_pointer;
+ Parrot_String return_name = Parrot_str_new_constant(interp, "returns");
+ Parrot_String sig_name = Parrot_str_new_constant(interp, "signature");
+ full_sig = VTABLE_get_string(interp, sig_object);
+ Parrot_str_concat(interp, full_sig,
+ Parrot_str_new_constant(interp, "->P"), 0);
+
+ return_pointer = pmc_new(interp, enum_class_CPointer);
+
+ returns = VTABLE_get_attr_str(interp, sig_object, return_name);
+ if (PMC_IS_NULL(returns)) {
+ returns = pmc_new(interp, enum_class_ResizablePMCArray);
+ VTABLE_set_attr_str(interp, sig_object, return_name, returns);
+ }
+ VTABLE_set_pointer(interp, return_pointer, &result);
+ VTABLE_set_string_keyed_str(interp, return_pointer, sig_name,
+ Parrot_str_new_constant(interp, "P"));
+ VTABLE_push_pmc(interp, returns, return_pointer);
+ break;
+ }
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "Dispatch: invalid return type %c!", return_sig);
+ }
- PARROT_CALLIN_START(interp);
+ Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, sig_object);
- va_start(ap, signature);
- PMC_get_sub(interp, sub_pmc, sub);
- Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp), sub->seg->const_table->constants);
- result = Parrot_runops_fromc_arglist(interp, sub_pmc, signature, ap);
- va_end(ap);
-
- PARROT_CALLIN_END(interp);
return result;
}
Modified: branches/pcc_reapply/src/hash.c
==============================================================================
--- branches/pcc_reapply/src/hash.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/hash.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -1302,18 +1302,19 @@
const UINTVAL hashval = (hash->hash_val)(interp, key, hash->seed);
HashBucket *bucket = hash->bi[hashval & hash->mask];
- /* Very complex assert that we'll not put non-constant stuff into constant hash */
- PARROT_ASSERT(
- PMC_IS_NULL(hash->container)
- || !(PObj_constant_TEST(hash->container))
- || (
- (
- !(hash->key_type == Hash_key_type_STRING)
- || PObj_constant_TEST((PObj *)key))
- && (
- !((hash->entry_type == enum_type_PMC) || (hash->entry_type == enum_type_STRING))
- || PObj_constant_TEST((PObj *)value)))
- || !"Use non-constant key or value in constant hash");
+ /* When the hash is constant, check that the key and value are also
+ * constant. */
+ if (!PMC_IS_NULL(hash->container)
+ && PObj_constant_TEST(hash->container)) {
+ if (hash->key_type == Hash_key_type_STRING
+ && !PObj_constant_TEST((PObj *)key))
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "Used non-constant key in constant hash.");
+ if (((hash->entry_type == enum_type_PMC) || (hash->entry_type == enum_type_STRING))
+ && !PObj_constant_TEST((PObj *)value))
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "Used non-constant value in constant hash.");
+ }
while (bucket) {
/* store hash_val or not */
Modified: branches/pcc_reapply/src/interp/inter_cb.c
==============================================================================
--- branches/pcc_reapply/src/interp/inter_cb.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/interp/inter_cb.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -294,7 +294,7 @@
char *p;
char ch;
char *sig_cstr;
- char pasm_sig[4];
+ char pasm_sig[5];
INTVAL i_param;
PMC *p_param;
void *param = NULL; /* avoid -Ox warning */
@@ -310,13 +310,12 @@
p = sig_cstr;
++p; /* Skip return type */
- pasm_sig[0] = 'v'; /* no return value supported yet */
- pasm_sig[1] = 'P';
+ pasm_sig[0] = 'P';
if (*p == 'U') /* user_data Z in pdd16 */
++p; /* p is now type of external data */
switch (*p) {
case 'v':
- pasm_sig[2] = 'v';
+ pasm_sig[1] = 'v';
break;
#if 0
case '2':
@@ -335,7 +334,7 @@
case 'c':
i_param = (INTVAL)(char)(long)external_data;
case_I:
- pasm_sig[2] = 'I';
+ pasm_sig[1] = 'I';
param = (void*) i_param;
break;
#if 0
@@ -350,16 +349,16 @@
/* created a UnManagedStruct */
p_param = pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, p_param, external_data);
- pasm_sig[2] = 'P';
+ pasm_sig[1] = 'P';
param = (void*) p_param;
break;
#if 0
case 'P':
- pasm_sig[2] = 'P';
+ pasm_sig[1] = 'P';
break;
#endif
case 't':
- pasm_sig[2] = 'S';
+ pasm_sig[1] = 'S';
param = Parrot_str_new(interp, external_data, 0);
break;
default:
@@ -369,8 +368,10 @@
"unhandled signature char '%c' in run_cb", ch);
}
Parrot_str_free_cstring(sig_cstr);
- pasm_sig[3] = '\0';
- Parrot_runops_fromc_args_event(interp, sub, pasm_sig,
+ pasm_sig[2] = '-';
+ pasm_sig[3] = '>'; /* no return value supported yet */
+ pasm_sig[4] = '\0';
+ Parrot_pcc_invoke_sub_from_c_args(interp, sub, pasm_sig,
user_data, param);
}
/*
Modified: branches/pcc_reapply/src/library.c
==============================================================================
--- branches/pcc_reapply/src/library.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/library.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -162,6 +162,7 @@
PMC *paths;
STRING *entry;
STRING *versionlib = NULL;
+ STRING *builddir = NULL;
PMC * const iglobals = interp->iglobals;
PMC * const config_hash =
@@ -173,21 +174,31 @@
VTABLE_set_pmc_keyed_int(interp, iglobals,
IGLOBALS_LIB_PATHS, lib_paths);
+ if (VTABLE_elements(interp, config_hash)) {
+ STRING * const libkey = CONST_STRING(interp, "libdir");
+ STRING * const verkey = CONST_STRING(interp, "versiondir");
+ STRING * const builddirkey = CONST_STRING(interp, "build_dir");
+ versionlib = VTABLE_get_string_keyed_str(interp, config_hash, libkey);
+ entry = VTABLE_get_string_keyed_str(interp, config_hash, verkey);
+ versionlib = Parrot_str_append(interp, versionlib, entry);
+
+ builddir = VTABLE_get_string_keyed_str(interp, config_hash, builddirkey);
+ }
+
/* each is an array of strings */
/* define include paths */
paths = pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_INCLUDE, paths);
- entry = CONST_STRING(interp, "runtime/parrot/include/");
- VTABLE_push_string(interp, paths, entry);
+ if (!STRING_IS_NULL(builddir)) {
+ entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/"), 0);
+ VTABLE_push_string(interp, paths, entry);
+ entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/include/"), 0);
+ VTABLE_push_string(interp, paths, entry);
+ }
entry = CONST_STRING(interp, "./");
VTABLE_push_string(interp, paths, entry);
- if (VTABLE_elements(interp, config_hash)) {
- STRING * const libkey = CONST_STRING(interp, "libdir");
- STRING * const verkey = CONST_STRING(interp, "versiondir");
- versionlib = VTABLE_get_string_keyed_str(interp, config_hash, libkey);
- entry = VTABLE_get_string_keyed_str(interp, config_hash, verkey);
- versionlib = Parrot_str_append(interp, versionlib, entry);
+ if (!STRING_IS_NULL(versionlib)) {
entry = Parrot_str_concat(interp, versionlib, CONST_STRING(interp, "/include/"), 0);
VTABLE_push_string(interp, paths, entry);
}
@@ -197,8 +208,10 @@
paths = pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_LIBRARY, paths);
- entry = CONST_STRING(interp, "runtime/parrot/library/");
- VTABLE_push_string(interp, paths, entry);
+ if (!STRING_IS_NULL(builddir)) {
+ entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/library/"), 0);
+ VTABLE_push_string(interp, paths, entry);
+ }
entry = CONST_STRING(interp, "./");
VTABLE_push_string(interp, paths, entry);
if (!STRING_IS_NULL(versionlib)) {
@@ -210,8 +223,10 @@
paths = pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_LANG, paths);
- entry = CONST_STRING(interp, "runtime/parrot/languages/");
- VTABLE_push_string(interp, paths, entry);
+ if (!STRING_IS_NULL(builddir)) {
+ entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/languages/"), 0);
+ VTABLE_push_string(interp, paths, entry);
+ }
entry = CONST_STRING(interp, "./");
VTABLE_push_string(interp, paths, entry);
if (!STRING_IS_NULL(versionlib)) {
@@ -223,8 +238,10 @@
paths = pmc_new(interp, enum_class_ResizableStringArray);
VTABLE_set_pmc_keyed_int(interp, lib_paths,
PARROT_LIB_PATH_DYNEXT, paths);
- entry = CONST_STRING(interp, "runtime/parrot/dynext/");
- VTABLE_push_string(interp, paths, entry);
+ if (!STRING_IS_NULL(builddir)) {
+ entry = Parrot_str_concat(interp, builddir, CONST_STRING(interp, "/runtime/parrot/dynext/"), 0);
+ VTABLE_push_string(interp, paths, entry);
+ }
entry = CONST_STRING(interp, "dynext/");
VTABLE_push_string(interp, paths, entry);
if (!STRING_IS_NULL(versionlib)) {
Modified: branches/pcc_reapply/src/multidispatch.c
==============================================================================
--- branches/pcc_reapply/src/multidispatch.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/multidispatch.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -654,25 +654,19 @@
Parrot_mmd_build_type_tuple_from_sig_obj(PARROT_INTERP, ARGIN(PMC *sig_obj))
{
ASSERT_ARGS(Parrot_mmd_build_type_tuple_from_sig_obj)
- PMC * const type_tuple = pmc_new(interp, enum_class_FixedIntegerArray);
+ PMC * const type_tuple = pmc_new(interp, enum_class_ResizableIntegerArray);
STRING *string_sig = VTABLE_get_string(interp, sig_obj);
- const INTVAL sig_len = Parrot_str_byte_length(interp, string_sig);
INTVAL tuple_size = 0;
INTVAL args_ended = 0;
INTVAL i, seen_invocant = 0;
+ INTVAL sig_len;
- /* First calculate the number of arguments participating in MMD */
- for (i = 0; i < sig_len; ++i) {
- INTVAL type = Parrot_str_indexed(interp, string_sig, i);
- if (type == '-')
- break;
- if (type == 'i')
- continue;
-
- tuple_size++;
+ if (STRING_IS_NULL(string_sig)) {
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "Call has no signature, unable to dispatch.\n");
}
- VTABLE_set_integer_native(interp, type_tuple, tuple_size);
+ sig_len = Parrot_str_byte_length(interp, string_sig);
for (i = 0; i < sig_len; ++i) {
INTVAL type = Parrot_str_indexed(interp, string_sig, i + seen_invocant);
Modified: branches/pcc_reapply/src/ops/core.ops
==============================================================================
--- branches/pcc_reapply/src/ops/core.ops Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/ops/core.ops Tue Sep 29 23:13:51 2009 (r41567)
@@ -516,93 +516,76 @@
op set_args(inconst PMC) :flow {
- opcode_t * const _this = CUR_OPCODE;
+ opcode_t * const raw_args = CUR_OPCODE;
PMC * const signature = $1;
+ PMC * call_sig;
INTVAL argc;
- /* for now just point to the opcode */
- interp->current_args = _this;
+ call_sig = Parrot_pcc_build_sig_object_from_op(interp,
+ PMCNULL, signature, raw_args);
+ Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), call_sig);
+
argc = VTABLE_elements(interp, signature);
- goto OFFSET(argc + 2);
+ goto OFFSET(argc + 3);
}
op get_results(inconst PMC) :flow {
- opcode_t * const _this = CUR_OPCODE;
+ opcode_t * const raw_returns = CUR_OPCODE;
PMC * const signature = $1;
+ PMC * call_sig;
INTVAL argc;
- Parrot_pcc_set_results(interp, CURRENT_CONTEXT(interp), _this);
+ call_sig = Parrot_pcc_build_sig_object_returns_from_op(interp,
+ Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp)),
+ signature, raw_returns);
+ Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), call_sig);
+
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);
caller_ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
+ call_object = Parrot_pcc_get_signature(interp, 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);
+ call_object = Parrot_pcc_get_signature(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);
- }
+ Parrot_pcc_fill_returns_from_op(interp, call_object, signature, raw_returns);
+
+ gc_unregister_pmc(interp, call_object);
+ Parrot_pcc_set_signature(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_reapply/src/packfile.c
==============================================================================
--- branches/pcc_reapply/src/packfile.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/packfile.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -678,7 +678,7 @@
Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp),
interp->code->const_table->constants);
- retval = (PMC *)Parrot_runops_fromc_args(interp, sub_pmc, "P");
+ Parrot_pcc_invoke_sub_from_c_args(interp, sub_pmc, "->P", &retval);
interp->run_core = old_core;
return retval;
Modified: branches/pcc_reapply/src/pmc/callsignature.pmc
==============================================================================
--- branches/pcc_reapply/src/pmc/callsignature.pmc Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/pmc/callsignature.pmc Tue Sep 29 23:13:51 2009 (r41567)
@@ -28,9 +28,11 @@
PARROT_CAPTURE(obj)->hash = pmc_new((i), enum_class_Hash);
pmclass CallSignature extends Capture auto_attrs provides array provides hash {
- ATTR PMC *returns; /* Result PMCs, if they were passed with the call */
- ATTR PMC *type_tuple; /* Cached argument types for multiple dispatch */
- ATTR STRING *short_sig; /* Simple string signature args & returns */
+ ATTR PMC *returns; /* Storage for return arguments */
+ ATTR PMC *type_tuple; /* Cached argument types for multiple dispatch */
+ ATTR STRING *short_sig; /* Simple string signature args & returns */
+ ATTR PMC *arg_flags; /* Integer array of argument flags */
+ ATTR PMC *return_flags; /* Integer array of return argument flags */
/*
@@ -132,6 +134,16 @@
Stores the return signature, an array of PMCs.
+=item arg_flags
+
+Stores a set of flags for the call signature arguments, an array of
+integers.
+
+=item return_flags
+
+Stores a set of flags for the call signature return arguments, an array
+of integers.
+
=back
=cut
@@ -139,8 +151,21 @@
*/
VTABLE void set_attr_str(STRING *key, PMC *value) {
- Parrot_CallSignature_attributes * const sig_struct = PARROT_CALLSIGNATURE(SELF);
- sig_struct->returns = value;
+
+ if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "returns"))) {
+ SET_ATTR_returns(interp, SELF, value);
+ }
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "arg_flags"))) {
+ SET_ATTR_arg_flags(interp, SELF, value);
+ }
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "return_flags"))) {
+ SET_ATTR_return_flags(interp, SELF, value);
+ }
+ else {
+ /* If unknown attribute name, throw an exception. */
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
+ "No such attribute '%S'", key);
+ }
}
/*
@@ -155,6 +180,16 @@
Retrieves the return signature, an array of PMCs.
+=item arg_flags
+
+Retrieves the flags for the call signature arguments, an array of
+integers.
+
+=item return_flags
+
+Retrieves the flags for the call signature return arguments, an array of
+integers.
+
=back
=cut
@@ -162,8 +197,24 @@
*/
VTABLE PMC *get_attr_str(STRING *key) {
- Parrot_CallSignature_attributes * const sig_struct = PARROT_CALLSIGNATURE(SELF);
- return sig_struct->returns;
+ PMC *value = PMCNULL;
+
+ if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "returns"))) {
+ GET_ATTR_returns(interp, SELF, value);
+ }
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "arg_flags"))) {
+ GET_ATTR_arg_flags(interp, SELF, value);
+ }
+ else if (Parrot_str_equal(INTERP, key, CONST_STRING(INTERP, "return_flags"))) {
+ GET_ATTR_return_flags(interp, SELF, value);
+ }
+ else {
+ /* If unknown attribute name, throw an exception. */
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
+ "No such attribute '%S'", key);
+ }
+
+ return value;
}
/*
Modified: branches/pcc_reapply/src/pmc/capture.pmc
==============================================================================
--- branches/pcc_reapply/src/pmc/capture.pmc Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/pmc/capture.pmc Tue Sep 29 23:13:51 2009 (r41567)
@@ -417,6 +417,90 @@
/*
+=item C<void set_number_keyed_str(STRING *key, FLOATVAL value)>
+
+=item C<void set_integer_keyed_str(STRING *key, INTVAL value)>
+
+=item C<void set_pmc_keyed_str(STRING *key, PMC *value)>
+
+=item C<void set_string_keyed_str(STRING *key, STRING *value)>
+
+Sets a value in the hash component of the Capture.
+
+=cut
+
+*/
+
+ VTABLE void set_number_keyed_str(STRING *key, FLOATVAL value) {
+ CAPTURE_hash_CREATE(INTERP, SELF);
+ VTABLE_set_number_keyed_str(INTERP, PARROT_CAPTURE(SELF)->hash,
+ key, value);
+ }
+
+ VTABLE void set_integer_keyed_str(STRING *key, INTVAL value) {
+ CAPTURE_hash_CREATE(INTERP, SELF);
+ VTABLE_set_integer_keyed_str(INTERP, PARROT_CAPTURE(SELF)->hash,
+ key, value);
+ }
+
+ VTABLE void set_pmc_keyed_str(STRING *key, PMC *value) {
+ CAPTURE_hash_CREATE(INTERP, SELF);
+ VTABLE_set_pmc_keyed_str(INTERP, PARROT_CAPTURE(SELF)->hash,
+ key, value);
+ }
+
+ VTABLE void set_string_keyed_str(STRING *key, STRING *value) {
+ CAPTURE_hash_CREATE(INTERP, SELF);
+ VTABLE_set_string_keyed_str(INTERP, PARROT_CAPTURE(SELF)->hash,
+ key, value);
+ }
+
+/*
+
+=item C<FLOATVAL get_number_keyed_str(STRING *key)>
+
+=item C<INTVAL get_integer_keyed_str(STRING *key)>
+
+=item C<PMC *get_pmc_keyed_str(STRING *key)>
+
+=item C<STRING *get_string_keyed_str(STRING *key)>
+
+Retrieves a value in the hash component of the Capture.
+
+=cut
+
+*/
+
+ VTABLE FLOATVAL get_number_keyed_str(STRING *key) {
+ if (!(PARROT_CAPTURE(SELF)->hash))
+ return 0.0;
+ return VTABLE_get_number_keyed_str(INTERP, PARROT_CAPTURE(SELF)->hash,
+ key);
+ }
+
+ VTABLE INTVAL get_integer_keyed_str(STRING *key) {
+ if (!(PARROT_CAPTURE(SELF)->hash))
+ return 0;
+ return VTABLE_get_integer_keyed_str(INTERP, PARROT_CAPTURE(SELF)->hash,
+ key);
+ }
+
+ VTABLE PMC *get_pmc_keyed_str(STRING *key) {
+ if (!(PARROT_CAPTURE(SELF)->hash))
+ return PMCNULL;
+ return VTABLE_get_pmc_keyed_str(INTERP, PARROT_CAPTURE(SELF)->hash,
+ key);
+ }
+
+ VTABLE STRING *get_string_keyed_str(STRING *key) {
+ if (!(PARROT_CAPTURE(SELF)->hash))
+ return CONST_STRING(INTERP, "");
+ return VTABLE_get_string_keyed_str(INTERP, PARROT_CAPTURE(SELF)->hash,
+ key);
+ }
+
+/*
+
=item C<INTVAL defined_keyed(PMC *key)>
Return true if element C<key> of the hash component is defined.
@@ -450,6 +534,39 @@
/*
+=item C<INTVAL defined_keyed_str(STRING *key)>
+
+Return true if element C<key> of the hash component is defined.
+
+=item C<INTVAL exists_keyed_str(STRING *key)>
+
+Return true if element C<key> of the hash component exists.
+
+=item C<void delete_keyed_str(STRING *key)>
+
+Delete the element corresponding to C<key> in the hash component.
+
+=cut
+
+*/
+
+ VTABLE INTVAL defined_keyed_str(STRING *key) {
+ if (!PARROT_CAPTURE(SELF)->hash) return 0;
+ return VTABLE_defined_keyed_str(INTERP, PARROT_CAPTURE(SELF)->hash, key);
+ }
+
+ VTABLE INTVAL exists_keyed_str(STRING *key) {
+ if (!PARROT_CAPTURE(SELF)->hash) return 0;
+ return VTABLE_exists_keyed_str(INTERP, PARROT_CAPTURE(SELF)->hash, key);
+ }
+
+ VTABLE void delete_keyed_str(STRING *key) {
+ if (PARROT_CAPTURE(SELF)->hash)
+ VTABLE_delete_keyed_str(INTERP, PARROT_CAPTURE(SELF)->hash, key);
+ }
+
+/*
+
=item C<void set_pmc(PMC *capture)>
Set this capture to hold the value of another. If set to PMCNULL,
Modified: branches/pcc_reapply/src/pmc/class.pmc
==============================================================================
--- branches/pcc_reapply/src/pmc/class.pmc Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/pmc/class.pmc Tue Sep 29 23:13:51 2009 (r41567)
@@ -375,7 +375,8 @@
meth = Parrot_oo_find_vtable_override_for_class(interp, parent, name);
if (!PMC_IS_NULL(meth))
- Parrot_run_meth_fromc_args(interp, meth, object, name, "vP", init);
+ Parrot_pcc_invoke_sub_from_c_args(interp, meth,
+ "PiP->", object, init);
}
}
Modified: branches/pcc_reapply/src/pmc/cpointer.pmc
==============================================================================
--- branches/pcc_reapply/src/pmc/cpointer.pmc Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/pmc/cpointer.pmc Tue Sep 29 23:13:51 2009 (r41567)
@@ -85,19 +85,6 @@
void *pointer;
GET_ATTR_pointer(INTERP, SELF, pointer);
Parrot_gc_mark_STRING_alive(interp, sig);
-
- if (pointer) {
- if (Parrot_str_equal(interp, sig, CONST_STRING(interp, "P"))) {
- PMC ** const pmc_pointer = (PMC **) pointer;
- PARROT_ASSERT(*pmc_pointer);
- Parrot_gc_mark_PMC_alive(interp, *pmc_pointer);
- }
- else if (Parrot_str_equal(interp, sig, CONST_STRING(interp, "S"))) {
- STRING ** const str_pointer = (STRING **) pointer;
- PARROT_ASSERT(*str_pointer);
- Parrot_gc_mark_STRING_alive(interp, *str_pointer);
- }
- }
}
}
Modified: branches/pcc_reapply/src/pmc/multisub.pmc
==============================================================================
--- branches/pcc_reapply/src/pmc/multisub.pmc Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/pmc/multisub.pmc Tue Sep 29 23:13:51 2009 (r41567)
@@ -57,7 +57,9 @@
}
VTABLE opcode_t *invoke(void *next) {
- PMC * const func = Parrot_mmd_sort_manhattan(interp, SELF);
+ PMC * const sig_obj = CONTEXT(interp)->current_sig;
+ PMC * const func = Parrot_mmd_sort_manhattan_by_sig_pmc(interp,
+ SELF, sig_obj);
if (PMC_IS_NULL(func))
Parrot_ex_throw_from_c_args(INTERP, NULL, 1, "No applicable methods.\n");
Modified: branches/pcc_reapply/src/pmc/nci.pmc
==============================================================================
--- branches/pcc_reapply/src/pmc/nci.pmc Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/pmc/nci.pmc Tue Sep 29 23:13:51 2009 (r41567)
@@ -72,8 +72,8 @@
case (INTVAL)'@':
param_sig[j++] = '@';
break;
- case (INTVAL)'b': /* buffer (void*) pass PObj_bufstart(SReg) */
- case (INTVAL)'B': /* buffer (void**) pass &PObj_bufstart(SReg) */
+ case (INTVAL)'b': /* buffer (void*) pass Buffer_bufstart(SReg)
+ case (INTVAL)'B': /* buffer (void**) pass &Buffer_bufstart(SReg) */
param_sig[j++] = 'S';
break;
default:
Modified: branches/pcc_reapply/src/pmc/object.pmc
==============================================================================
--- branches/pcc_reapply/src/pmc/object.pmc Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/pmc/object.pmc Tue Sep 29 23:13:51 2009 (r41567)
@@ -171,8 +171,12 @@
/* If there's a vtable override for 'name' run that instead. */
PMC * const method = Parrot_oo_find_vtable_override(interp, _class, name);
- if (!PMC_IS_NULL(method))
- return (STRING *)Parrot_run_meth_fromc_args(interp, method, SELF, name, "S");
+ if (!PMC_IS_NULL(method)) {
+ STRING *result;
+ Parrot_pcc_invoke_sub_from_c_args(interp, method, "Pi->S",
+ SELF, &result);
+ return result;
+ }
else
return VTABLE_get_string(interp, _class);
}
@@ -214,9 +218,12 @@
PMC * const method = Parrot_oo_find_vtable_override(interp,
VTABLE_get_class(interp, SELF), get_attr);
- if (!PMC_IS_NULL(method))
- return (PMC *)Parrot_run_meth_fromc_args(interp, method, SELF,
- get_attr, "PS", name);
+ if (!PMC_IS_NULL(method)) {
+ PMC *result;
+ Parrot_pcc_invoke_sub_from_c_args(interp, method, "PiS->P",
+ SELF, name, &result);
+ return result;
+ }
/* Look up the index. */
index = get_attrib_index(interp, obj->_class, name);
@@ -273,9 +280,8 @@
PMC * const method = Parrot_oo_find_vtable_override(interp,
VTABLE_get_class(interp, SELF), vtable_meth_name);
if (!PMC_IS_NULL(method)) {
- PMC *unused = (PMC *)Parrot_run_meth_fromc_args(interp, method,
- SELF, vtable_meth_name, "vSP", name, value);
- UNUSED(unused);
+ Parrot_pcc_invoke_sub_from_c_args(interp, method, "PiSP->",
+ SELF, name, value);
return;
}
@@ -345,9 +351,12 @@
method = Parrot_oo_find_vtable_override_for_class(interp, cur_class,
find_method);
- if (!PMC_IS_NULL(method))
- return (PMC *)Parrot_run_meth_fromc_args(interp, method, SELF,
- find_method, "PS", name);
+ if (!PMC_IS_NULL(method)) {
+ PMC *result;
+ Parrot_pcc_invoke_sub_from_c_args(interp, method,
+ "PiS->P", SELF, name, &result);
+ return result;
+ }
/* If it's from this universe or the class doesn't inherit from
* anything outside of it... */
@@ -391,9 +400,8 @@
cur_class, meth_name);
if (!PMC_IS_NULL(meth)) {
INTVAL result;
- Parrot_pcc_invoke_sub_from_c_args(interp, meth, "P->I", pmc, &result);
+ Parrot_pcc_invoke_sub_from_c_args(interp, meth, "Pi->I", pmc, &result);
return result;
-/* return (INTVAL)Parrot_run_meth_fromc_args_reti(interp, meth, pmc, meth_name, "I"); */
}
/* method name is get_integer */
@@ -427,9 +435,12 @@
PMC * const method = Parrot_oo_find_vtable_override(interp,
classobj, get_class);
- if (!PMC_IS_NULL(method))
- return (PMC *)Parrot_run_meth_fromc_args(interp, method, SELF,
- get_class, "P");
+ if (!PMC_IS_NULL(method)) {
+ PMC *result;
+ Parrot_pcc_invoke_sub_from_c_args(interp, method, "Pi->P",
+ SELF, &result);
+ return result;
+ }
return classobj;
}
@@ -451,9 +462,12 @@
PMC * const method = Parrot_oo_find_vtable_override(interp,
classobj, get_namespace);
- if (!PMC_IS_NULL(method))
- return (PMC *)Parrot_run_meth_fromc_args(interp, method, SELF,
- get_namespace, "P");
+ if (!PMC_IS_NULL(method)) {
+ PMC *result;
+ Parrot_pcc_invoke_sub_from_c_args(interp, method, "Pi->P",
+ SELF, &result);
+ return result;
+ }
else
return VTABLE_inspect_str(interp, classobj, CONST_STRING(interp, "namespace"));
@@ -537,9 +551,13 @@
PMC * const method = Parrot_oo_find_vtable_override(interp,
classobj, meth_name);
- if (!PMC_IS_NULL(method)
- && Parrot_run_meth_fromc_args_reti(interp, method, SELF, meth_name, "IS", role_name))
- return 1;
+ if (!PMC_IS_NULL(method)) {
+ INTVAL result;
+ Parrot_pcc_invoke_sub_from_c_args(interp, method,
+ "PiS->I", SELF, role_name, &result);
+ if (result)
+ return 1;
+ }
}
/* Check the superclass's vtable interface, if any. */
if (SUPER(role_name))
@@ -646,8 +664,12 @@
STRING * const meth_name = CONST_STRING(interp, "clone");
PMC * const meth =
Parrot_oo_find_vtable_override(interp, obj->_class, meth_name);
- if (!PMC_IS_NULL(meth))
- return (PMC*)Parrot_run_meth_fromc_args(interp, meth, pmc, meth_name, "P");
+ if (!PMC_IS_NULL(meth)) {
+ PMC *result;
+ Parrot_pcc_invoke_sub_from_c_args(interp, meth, "Pi->P",
+ pmc, &result);
+ return result;
+ }
else
return Parrot_oo_clone_object(interp, SELF, obj->_class, NULL);
}
@@ -793,7 +815,8 @@
classobj, meth_name);
if (!PMC_IS_NULL(method))
- Parrot_run_meth_fromc_args(interp, method, SELF, meth_name, "vP", type);
+ Parrot_pcc_invoke_sub_from_c_args(interp, method, "PiP->",
+ SELF, type);
else
SUPER(type);
}
Modified: branches/pcc_reapply/src/scheduler.c
==============================================================================
--- branches/pcc_reapply/src/scheduler.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/scheduler.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -140,8 +140,8 @@
PMC * const handler = Parrot_cx_find_handler_for_task(interp, task);
if (!PMC_IS_NULL(handler)) {
PMC * const handler_sub = VTABLE_get_attr_str(interp, handler, CONST_STRING(interp, "code"));
- Parrot_runops_fromc_args_event(interp, handler_sub,
- "vPP", handler, task);
+ Parrot_pcc_invoke_sub_from_c_args(interp, handler_sub,
+ "PP->", handler, task);
}
}
else {
@@ -952,8 +952,8 @@
Parrot_floatval_time());
#endif
if (!PMC_IS_NULL(timer_struct->codeblock)) {
- Parrot_runops_fromc_args_event(interp,
- timer_struct->codeblock, "v");
+ Parrot_pcc_invoke_sub_from_c_args(interp,
+ timer_struct->codeblock, "->");
}
}
Modified: branches/pcc_reapply/src/thread.c
==============================================================================
--- branches/pcc_reapply/src/thread.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/thread.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -532,7 +532,7 @@
Parrot_ex_add_c_handler(interp, &jump_point);
Parrot_unblock_GC_mark(interp);
Parrot_unblock_GC_sweep(interp);
- ret_val = Parrot_runops_fromc_args(interp, sub_pmc, "PF", sub_arg);
+ Parrot_pcc_invoke_sub_from_c_args(interp, sub_pmc, "P->P", sub_arg, &ret_val);
}
/* thread is finito */
Modified: branches/pcc_reapply/src/utils.c
==============================================================================
--- branches/pcc_reapply/src/utils.c Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/src/utils.c Tue Sep 29 23:13:51 2009 (r41567)
@@ -906,6 +906,7 @@
COMPARE(PARROT_INTERP, ARGIN(void *a), ARGIN(void *b), ARGIN(PMC *cmp))
{
ASSERT_ARGS(COMPARE)
+ INTVAL result;
if (PMC_IS_NULL(cmp))
return VTABLE_cmp(interp, (PMC *)a, (PMC *)b);
@@ -914,7 +915,8 @@
return f(interp, a, b);
}
- return Parrot_runops_fromc_args_reti(interp, cmp, "IPP", a, b);
+ Parrot_pcc_invoke_sub_from_c_args(interp, cmp, "PP->I", a, b, &result);
+ return result;
}
/*
Modified: branches/pcc_reapply/t/op/annotate.t
==============================================================================
--- branches/pcc_reapply/t/op/annotate.t Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/t/op/annotate.t Tue Sep 29 23:13:51 2009 (r41567)
@@ -36,8 +36,8 @@
failed:
.local pmc exception
- .get_results (exception)
pop_eh
+ .get_results (exception)
$P0 = exception.'annotations'()
isa_ok ($P0, 'Hash', 'annotations gives back hash')
$I0 = elements $P0
@@ -59,6 +59,7 @@
failed:
.local pmc exception
+ pop_eh
.get_results (exception)
pop_eh
@@ -108,6 +109,7 @@
failed:
.local pmc exception, bt, frame, ann
+ pop_eh
.get_results (exception)
pop_eh
bt = exception.'backtrace'()
Modified: branches/pcc_reapply/t/op/calling.t
==============================================================================
--- branches/pcc_reapply/t/op/calling.t Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/t/op/calling.t Tue Sep 29 23:13:51 2009 (r41567)
@@ -447,7 +447,7 @@
print $P0
.end
CODE
-/too few arguments passed/
+/too few positional arguments/
OUTPUT
pir_output_like(
@@ -478,7 +478,7 @@
print "nada"
.end
CODE
-/too many arguments passed/
+/too many positional arguments/
OUTPUT
pir_error_output_like( <<'CODE', <<'OUTPUT', "argc mismatch, too many" );
@@ -496,7 +496,7 @@
print $P0
.end
CODE
-/too many arguments passed/
+/too many positional arguments/
OUTPUT
pir_output_like( <<'CODE', <<'OUTPUT', "argc mismatch, too many - catch exception" );
@@ -524,7 +524,7 @@
# print $S1
.end
CODE
-/^caught: too many arguments passed/
+/^caught: too many positional arguments/
OUTPUT
pir_output_is( <<'CODE', <<'OUTPUT', "argc mismatch, optional" );
@@ -571,7 +571,7 @@
.param int got_k :opt_flag
.end
CODE
-/too many arguments passed/
+/too many positional arguments/
OUTPUT
pasm_output_is( <<'CODE', <<'OUTPUT', "get_param later" );
@@ -1210,7 +1210,7 @@
$P35 = _fn1(1, $P34 :flat)
.end
CODE
-/too many arguments passed \(5\) - 4 params expected/
+/too many positional arguments: 5 passed, 4 expected/
OUTPUT
pir_error_output_like( <<'CODE', <<'OUTPUT', "too few args via :flat" );
@@ -1242,7 +1242,7 @@
$P35 = _fn1(1, $P34 :flat)
.end
CODE
-/too few arguments passed \(3\) - 4 params expected/
+/too few positional arguments: 3 passed, 4 \(or more\) expected/
OUTPUT
pir_output_is( <<'CODE', <<'OUTPUT', "tailcall to NCI" );
Modified: branches/pcc_reapply/t/pmc/capture.t
==============================================================================
--- branches/pcc_reapply/t/pmc/capture.t Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/t/pmc/capture.t Tue Sep 29 23:13:51 2009 (r41567)
@@ -226,6 +226,7 @@
.return ()
test_get_integer_catch:
+ pop_eh
.local pmc exception
.local string message
.get_results (exception)
Modified: branches/pcc_reapply/t/pmc/resizablestringarray.t
==============================================================================
--- branches/pcc_reapply/t/pmc/resizablestringarray.t Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/t/pmc/resizablestringarray.t Tue Sep 29 23:13:51 2009 (r41567)
@@ -1374,6 +1374,7 @@
.local pmc exception
.local string message
bad_type:
+ pop_eh
.get_results (exception)
message = exception
still_ok:
Modified: branches/pcc_reapply/tools/build/nativecall.pl
==============================================================================
--- branches/pcc_reapply/tools/build/nativecall.pl Tue Sep 29 22:55:14 2009 (r41566)
+++ branches/pcc_reapply/tools/build/nativecall.pl Tue Sep 29 23:13:51 2009 (r41567)
@@ -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,77 @@
# 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 @{$extra_preamble_ref}, "t_$temp_num = ($ret_type)GET_NCI_$sig_table{$_}{sig_char}($reg_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 @{$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);";
+ push @{$fill_params_ref}, "&t_$temp_num";
return "Buffer_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_postamble_ref}, "do { if (s_$temp_num) Parrot_str_free_cstring(s_$temp_num); } while (0);";
return "v_$temp_num";
};
@@ -302,8 +326,8 @@
return "interp";
};
/[OP\@]/ && do {
- push @{$temps_ref}, "PMC *t_$temp_num;";
- push @{$extra_preamble_ref}, "t_$temp_num = GET_NCI_P($reg_num);";
+ push @{$temps_ref}, "PMC *t_$temp_num;";
+ push @{$fill_params_ref}, "&t_$temp_num";
return "t_$temp_num";
};
return;
@@ -311,10 +335,10 @@
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 +346,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 +359,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 +369,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 +386,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