Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

[IMCC] added full calling conventions to C PMC methods.

  * PMETHOD is the new syntax to identify an enhanced calling convention C PMC method.
  * PMETHOD return statements look like
      preturn(int a, PMC* b, STRING* c, int 12)
  * more refactor and clean up of inter_call.c
[IMCC] Added support for named args in C PMC METHODS

git-svn-id: https://svn.parrot.org/parrot/trunk@16676 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
commit d1c84dd67eb4b2244ae6a8c35b48508e8b89be31 1 parent 764922c
@tewk tewk authored
View
2  MANIFEST
@@ -2440,6 +2440,7 @@ src/pmc/parrotobject.pmc []
src/pmc/parrotrunningthread.pmc []
src/pmc/parrotthread.pmc []
src/pmc/pmc.num []
+src/pmc/pmethod_test.pmc []
src/pmc/pointer.pmc []
src/pmc/random.pmc []
src/pmc/ref.pmc []
@@ -2751,6 +2752,7 @@ t/pmc/parrotlibrary.t []
t/pmc/parrotobject.t []
t/pmc/parrotthread.t []
t/pmc/pmc.t []
+t/pmc/pmethod_test.t []
t/pmc/pointer.t []
t/pmc/prop.t []
t/pmc/random.t []
View
16 include/parrot/enums.h
@@ -48,20 +48,20 @@ typedef enum {
/* &gen_from_enum(call_bits.pasm) */
typedef enum {
/* 4 low bits are argument types */
- PARROT_ARG_INTVAL = 0x000,
- PARROT_ARG_STRING = 0x001,
- PARROT_ARG_PMC = 0x002,
- PARROT_ARG_FLOATVAL = 0x003,
+ PARROT_ARG_INTVAL = 0x000, /* 0 */
+ PARROT_ARG_STRING = 0x001, /* 1 */
+ PARROT_ARG_PMC = 0x002, /* 2 */
+ PARROT_ARG_FLOATVAL = 0x003, /* 3 */
PARROT_ARG_TYPE_MASK = 0x00f,
/* argument meaning and conversion bits */
- PARROT_ARG_CONSTANT = 0x010,
+ PARROT_ARG_CONSTANT = 0x010, /* 16 */
/* bits a user has to define */
PARROT_ARG_FLATTEN = 0x020, /* .flatten_arg */
PARROT_ARG_SLURPY_ARRAY = PARROT_ARG_FLATTEN, /* i.e. foldup */
/* unused - 0x040 */
- PARROT_ARG_OPTIONAL = 0x080,
- PARROT_ARG_OPT_FLAG = 0x100, /* prev optional was set */
- PARROT_ARG_NAME = 0x200 /* this String is an arg name */
+ PARROT_ARG_OPTIONAL = 0x080, /* 128 */
+ PARROT_ARG_OPT_FLAG = 0x100, /* 256 prev optional was set */
+ PARROT_ARG_NAME = 0x200 /* 512 this String is an arg name */
/* more to come soon */
} Call_bits_enum_t;
View
18 include/parrot/inter_call.h
@@ -106,12 +106,23 @@ struct call_state {
PMC *key; /* to iterate a flattening hash */
};
+typedef enum arg_pass_t {
+ PARROT_PASS_PARAMS = 0x00,
+ PARROT_PASS_RESULTS = 0x01,
+} arg_pass_t;
+
+PARROT_API int Parrot_init_arg_indexes_and_sig_pmc(Interp *interp, parrot_context_t *ctx,
+ opcode_t *indexes, PMC* sig_pmc, struct call_state_item *st);
+
PARROT_API int Parrot_init_arg_sig(Interp *, parrot_context_t *ctx,
const char *sig, void *ap, struct call_state_item *st);
PARROT_API int Parrot_init_arg_op(Interp *, parrot_context_t *ctx,
opcode_t *pc, struct call_state_item *st);
+PARROT_API void Parrot_process_args(Interp *interp, struct call_state *st,
+ arg_pass_t param_or_result);
+
PARROT_API int Parrot_init_arg_nci(Interp *, struct call_state *st, const char *sig);
PARROT_API int Parrot_init_ret_nci(Interp *, struct call_state *st, const char *sig);
@@ -120,15 +131,10 @@ PARROT_API int Parrot_fetch_arg_nci(Interp *, struct call_state *st);
PARROT_API void Parrot_convert_arg(Interp *, struct call_state *st);
PARROT_API int Parrot_store_arg(Interp *, struct call_state *st);
-#define PARROT_PASS_PARAMS 0
-#define PARROT_PASS_RESULTS 1
-
void parrot_pass_args(Interp *, parrot_context_t *src_ctx, parrot_context_t *dest_ctx,
- opcode_t *src_indexes, opcode_t *dest_indexes, int param_or_result);
+ opcode_t *src_indexes, opcode_t *dest_indexes, arg_pass_t param_or_result);
opcode_t * parrot_pass_args_fromc(Interp *, const char *sig,
opcode_t *dest, parrot_context_t * ctx, va_list ap);
-opcode_t * parrot_pass_args_to_result(Interp *interp, const char *sig,
- opcode_t *dest, parrot_context_t * old_ctxp, va_list ap);
void* set_retval(Interp*, int sig_ret, parrot_context_t *ctx);
INTVAL set_retval_i(Interp*, int sig_ret, parrot_context_t *ctx);
View
4 include/parrot/interpreter.h
@@ -542,8 +542,10 @@ void do_prederef(void **pc_prederef, Interp *interp, int type);
void clone_interpreter(Parrot_Interp dest, Parrot_Interp self, Parrot_clone_flags flags);
-PARROT_API void enter_nci_method(Interp *, int type,
+PARROT_API void enter_nci_method(Interp *, const int type,
void *func, const char *name, const char *proto);
+PARROT_API void register_raw_nci_method_in_ns(Parrot_Interp interp, const int type,
+ void *func, const char *name);
PARROT_API void Parrot_mark_method_writes(Interp *, int type, const char *name);
void Parrot_setup_event_func_ptrs(Parrot_Interp interp);
View
28 lib/Parrot/Pmc2c.pm
@@ -207,7 +207,7 @@ Returns C<$self> as a new instance.
C<$self> is a hash reference C<eval>-ed from a F<*.dump> file generated
by F<tools/build/pmc2c.pl> from a F<*.pmc> file. It is C<bless>-ed either into
-C<Parrot::Pmc2c::::Standard>, or into one of the other I<special> PMCs:
+C<Parrot::Pmc2c::Standard>, or into one of the other I<special> PMCs:
F<default>, C<delegate>, C<Null>, C<Ref> or C<SharedRef>.
C<$opt> is a hash reference.
@@ -761,9 +761,19 @@ EOH
## $cout .= $header_decls;
$cout .= $self->decl( $classname, $method, 0 );
- # This is the part that comes from the PMC file.
- $cout .= $self->line_directive( $method->{line}, $self->{file} );
- $cout .= "{$standard_body\n}\n";
+ if ( exists $method->{pre_block} ) {
+ $cout .= $method->{pre_block};
+ # This is the part that comes from the PMC file.
+ $cout .= $self->line_directive( $method->{line}, $self->{file} );
+ $cout .= $standard_body;
+ $cout .= $method->{post_block};
+ $cout .= "\n}\n";
+ }
+ else {
+ # This is the part that comes from the PMC file.
+ $cout .= $self->line_directive( $method->{line}, $self->{file} );
+ $cout .= "{$standard_body\n}\n";
+ }
# We are back to generated code immediately here
$cout .= $self->line_directive( 2 + $line + count_newlines($cout), $out_name );
@@ -1176,11 +1186,19 @@ EOC
foreach my $method ( @{ $self->{methods} } ) {
next unless $method->{loc} eq 'nci';
my $proto = proto( $method->{type}, $method->{parameters} );
- $cout .= <<"EOC";
+ if ( exists $method->{pre_block} ) {
+ $cout .= <<"EOC";
+ register_raw_nci_method_in_ns(interp, entry,
+ F2DPTR(Parrot_${classname}_$method->{meth}), "$method->{meth}");
+EOC
+ }
+ else {
+ $cout .= <<"EOC";
enter_nci_method(interp, entry,
F2DPTR(Parrot_${classname}_$method->{meth}),
"$method->{meth}", "$proto");
EOC
+ }
if ( $method->{attrs}{write} ) {
$cout .= <<"EOC";
Parrot_mark_method_writes(interp, entry, "$method->{meth}");
View
424 lib/Parrot/Pmc2c/Utils.pm
@@ -10,6 +10,7 @@ use Parrot::Pmc2c::Library;
use Parrot::Pmc2c qw(count_newlines);
use Cwd qw(cwd realpath);
use File::Basename;
+use Carp;
=head1 NAME
@@ -681,7 +682,7 @@ sub parse_pmc {
(?:/\*.*?\*/)? # C-like comments
)*
- (METHOD\s+)? #method flag
+ (P?METHOD\s+)? #method flag
(\w+\**) #type
\s+
@@ -697,37 +698,37 @@ sub parse_pmc {
$lineno += count_newlines($1);
my ($flag, $type, $methodname, $parameters) = ($2,$3,$4,$5);
my $attrs = parse_method_attrs($6);
- my ($methodblock, $rema) = extract_balanced($classblock);
-
+ my ($methodblock, $remainder_part) = extract_balanced($classblock);
$methodblock = "" if $opt->{nobody};
- if ($methodname eq 'class_init') {
- $class_init = {
- meth => $methodname,
- body => $methodblock,
- line => $lineno,
- type => $type,
- parameters => $parameters,
- loc => "vtable",
- attrs => $attrs,
- };
- }
- else {
- # name => method idx mapping
- $meth_hash{$methodname} = scalar @methods;
- my @mmds = ($methodblock =~ /MMD_(\w+):/g);
- push @methods,
- {
+
+ my $method_hash = {
meth => $methodname,
body => $methodblock,
line => $lineno,
type => $type,
parameters => $parameters,
- loc => $flag ? "nci" : "vtable",
- mmds => [ @mmds ],
+ loc => "vtable",
attrs => $attrs,
- };
+ };
+
+ if ($flag and $flag =~ /PMETHOD/) {
+ rewrite_pmethod($method_hash);
}
- $classblock = $rema;
+
+
+ if ($methodname eq 'class_init') {
+ $class_init = $method_hash;
+ }
+ else {
+ # name => method idx mapping
+ $meth_hash{$methodname} = scalar @methods;
+
+ $method_hash->{loc} = "nci" if $flag;
+ $method_hash->{mmds} = [ ($methodblock =~ /MMD_(\w+):/g) ];
+ push @methods, $method_hash;
+ }
+
+ $classblock = $remainder_part;
$lineno += count_newlines($methodblock);
}
@@ -745,6 +746,381 @@ sub parse_pmc {
};
}
+# Declare the subroutines
+sub trim($);
+sub ltrim($);
+sub rtrim($);
+
+# Perl trim function to remove whitespace from the start and end of the string
+sub trim($)
+{
+ my $string = shift;
+ $string =~ s/^\s+//;
+ $string =~ s/\s+$//;
+ return $string;
+}
+# Left trim function to remove leading whitespace
+sub ltrim($)
+{
+ my $string = shift;
+ $string =~ s/^\s+//;
+ return $string;
+}
+# Right trim function to remove trailing whitespace
+sub rtrim($)
+{
+ my $string = shift;
+ $string =~ s/\s+$//;
+ return $string;
+}
+
+use constant REGNO_INT => 0;
+use constant REGNO_NUM => 1;
+use constant REGNO_STR => 2;
+use constant REGNO_PMC => 3;
+
+ #/* 4 low bits are argument types */
+use constant PARROT_ARG_INTVAL => 0x000;
+use constant PARROT_ARG_STRING => 0x001;
+use constant PARROT_ARG_PMC => 0x002;
+use constant PARROT_ARG_FLOATVAL => 0x003;
+use constant PARROT_ARG_TYPE_MASK => 0x00f;
+ #/* argument meaning and conversion bits */
+use constant PARROT_ARG_CONSTANT => 0x010;
+ #/* bits a user has to define */
+use constant PARROT_ARG_FLATTEN => 0x020; # /* .flatten_arg */
+use constant PARROT_ARG_SLURPY_ARRAY => PARROT_ARG_FLATTEN; # /* i.e. foldup */
+ #/* unused - 0x040 */
+
+use constant PARROT_ARG_OPTIONAL => 0x080;
+use constant PARROT_ARG_OPT_FLAG => 0x100; #/* prev optional was set */
+use constant PARROT_ARG_NAME => 0x200; #/* this String is an arg name */
+
+our $arg_type_flags = {
++(REGNO_INT) => PARROT_ARG_INTVAL,
++(REGNO_NUM) => PARROT_ARG_FLOATVAL,
++(REGNO_STR) => PARROT_ARG_STRING,
++(REGNO_PMC) => PARROT_ARG_PMC
+};
+
+sub parse_arg_attrs {
+ my $flags = shift;
+ my %result;
+ if ( defined $flags ) {
+ ++$result{$1} while $flags =~ /:(\S+)/g;
+ }
+ return \%result;
+}
+
+sub get_arg_type {
+ ($_) = @_;
+ if (/INTVAL|int/i) {
+ return REGNO_INT;
+ return "INTVAL";
+ }
+ elsif (/FLOATVAL|double/i) {
+ return REGNO_NUM;
+ return "FLOATVAL";
+ }
+ elsif (/STRING/i) {
+ return REGNO_STR;
+ return "STRING";
+ }
+ elsif (/PMC/i) {
+ return REGNO_PMC;
+ return "PMC";
+ }
+ croak "$_ not recognized as INTVAL, FLOATVAL, STRING, or PMC";
+}
+
+
+sub gen_arg_flags {
+ my ($param) = @_;
+ my $flag = $arg_type_flags->{$param->{type}};
+ my $is_constant = 0;
+ my $is_optional = 0;
+ $is_constant = PARROT_ARG_CONSTANT if exists $param->{attrs}->{constant};
+ $is_optional = PARROT_ARG_OPTIONAL if exists $param->{attrs}->{optional};
+ $flag |= $is_constant | $is_optional;
+ $flag |= PARROT_ARG_FLATTEN if exists $param->{attrs}->{flatten};
+ $flag |= PARROT_ARG_SLURPY_ARRAY if exists $param->{attrs}->{slurpy};
+ $flag |= PARROT_ARG_NAME if exists $param->{attrs}->{name};
+
+ if (exists $param->{attrs}->{opt_flag}) {
+ return PARROT_ARG_INTVAL | PARROT_ARG_OPT_FLAG;
+ }
+
+ return $flag;
+}
+
+sub gen_arg_accessor {
+ my ($name, $type_number, $index, $arg_type) = @_;
+ my $type;
+ if ($type_number == REGNO_INT) {
+ $type = { s => "INTVAL", l => "INT" };
+ }
+ elsif ($type_number == REGNO_NUM) {
+ $type = { s => "FLOATVAL", l => "NUM" };
+ }
+ elsif ($type_number == REGNO_STR) {
+ $type = { s => "STRING*", l => "STR" };
+ }
+ elsif ($type_number == REGNO_PMC) {
+ $type = { s => "PMC*", l => "PMC" };
+ }
+ else {
+ croak "$_ not recognized as INTVAL, FLOATVAL, STRING, or PMC";
+ }
+
+ if ($arg_type eq 'param') {
+ return " $type->{s} $name = CTX_REG_$type->{l}(ctx, $index);\n";
+ }
+ elsif ($arg_type eq 'name') {
+ return " CTX_REG_$type->{l}(ctx, $index) = string_from_cstring(interp, $name, 0);\n";
+ }
+ else { #$arg_type eq 'result'
+ return " CTX_REG_$type->{l}(ctx, $index) = $name;\n";
+ }
+}
+
+=head3 C<rewrite_pmethod($class, $method, $body)>
+
+Rewrites the method body performing the various macro substitutions for
+pmethod bodies (see F<tools/build/pmc2c.pl>).
+
+=cut
+
+sub rewrite_pmethod_returns {
+ my ( $method, $body) = @_;
+ my $signature_re = qr{
+ (preturn #method name
+ \s* #optional whitespace
+ \( ([^\(]*) \) #parameters
+ ;?)
+ }sx;
+
+ my $regs_used = [];
+ if($_ and m/\breturn\b/) {
+ croak "return not allowed in pmethods, use preturn instead";
+ }
+
+ while ($$body and $$body =~ m/$signature_re/) {
+ my $goto_string = "goto $method"."_returns;";
+ my ($returns_n_regs_used, $returns_indexes, $returns_flags, $returns_accessors)
+ = parse_pmethod_args_normal($2, 'result');
+ push @$regs_used, $returns_n_regs_used;
+ my $file = '"' . __FILE__ . '"';
+ my $lineno = __LINE__ + 6;
+ my $replacement = <<END;
+
+ /*BEGIN PRETURN $2 */
+$returns_accessors
+#line $lineno $file
+ {
+ int temp_return_indexes[] = { $returns_indexes };
+ return_indexes = (opcode_t *) temp_return_indexes;
+ }
+ return_sig = Parrot_FixedIntegerArray_new_from_string(interp, type,
+ string_from_cstring(interp, $returns_flags, 0), PObj_constant_FLAG);
+ $goto_string
+ /*END PRETURN $2 */
+END
+ $$body =~ s/\Q$1\E/$replacement/;
+ }
+
+ return $regs_used;
+}
+
+sub parse_pmethod_args_normal {
+ my $linear_args = parse_pmethod_args($_[0]);
+ process_pmethod_args( $linear_args, $_[1] );
+}
+
+sub parse_pmethod_args_add_obj {
+ my $linear_args = parse_pmethod_args($_[0]);
+ my $arg = {
+ type => get_arg_type('PMC'),
+ name => 'self',
+ attrs => parse_arg_attrs(':object')
+ };
+ unshift @$linear_args, $arg;
+ process_pmethod_args( $linear_args, $_[1] );
+}
+
+sub parse_pmethod_args {
+ my ($parameters) = @_;
+ my $linear_args = [];
+ for my $x (split /,/, $parameters) {
+ my ($type, $name, $rest) = split / /, trim($x), 3;
+ $name =~ /[\**]?(\"?[\w_]+\"?)/;
+ my $arg = {
+ type => get_arg_type($type),
+ name => $1,
+ attrs => parse_arg_attrs($rest)
+ };
+ push @$linear_args, $arg;
+ }
+ $linear_args;
+}
+
+sub is_named {
+ my ($arg) = @_;
+ while (my ($k, $v) = each(%{ $arg->{attrs} })) {
+ if ($k =~ /named\[(.*)\]/)
+ {
+ return (1, $1);
+ }
+ }
+ return (0, '');
+}
+
+sub process_pmethod_args {
+ my ($linear_args, $arg_type) = @_;
+ my $n_regs_used_a = [ 0, 0, 0, 0 ];
+ my $args = [ [], [], [], [] ];
+ my $args_indexes_a = [];
+ my $args_flags_a = [];
+ my $args_accessors = "";
+ my $named_names = "";
+
+ for my $arg (@$linear_args)
+ {
+ my ($named, $named_name) = is_named($arg);
+ if($named)
+ {
+ my $argn = {
+ type => +(REGNO_STR),
+ name => $named_name,
+ };
+ $arg->{named_arg} = $argn;
+ $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}, $argn->{type}, $argn->{index}, '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->{name}, $arg->{type}, $arg->{index}, $arg_type);
+ }
+
+ my $n_regs_used = join(", ", @$n_regs_used_a);
+ my $args_indexes = join(", ", @$args_indexes_a);
+ my $args_flags = '"(' . join(", ", @$args_flags_a) . ')"';
+ return ($n_regs_used_a, $args_indexes, $args_flags, $args_accessors, $named_names);
+}
+
+sub find_max_regs {
+ my ($n_regs) = @_;
+ my $n_regs_used_a = [ 0, 0, 0, 0 ];
+ for my $x ( @$n_regs ) {
+ for my $i (0..3) {
+ $n_regs_used_a->[$i] = $n_regs_used_a->[$i] > $x->[$i] ? $n_regs_used_a->[$i] : $x->[$i];
+ }
+ }
+ return join(", ", @$n_regs_used_a);
+}
+
+=head3 C<rewrite_pmethod()>
+
+ rewrite_pmethod($method_hash);
+
+=cut
+
+
+sub rewrite_pmethod {
+ #"include pmc_fixedintegerarray.h";
+ my ($self) = @_;
+ croak "return method of PMETHOD must be void, not $self->{type}" if $self->{type} ne 'void';
+ my $parameters = $self->{parameters};
+ my ($params_n_regs_used, $params_indexes, $params_flags, $params_accessors, $named_names)
+ = parse_pmethod_args_add_obj($parameters, 'param');
+ my $n_regs = rewrite_pmethod_returns($self->{meth}, \$self->{body});
+ unshift @$n_regs, $params_n_regs_used;
+ my $n_regs_used = find_max_regs($n_regs);
+
+ my $file = '"' . __FILE__ . '"';
+ my $lineno = __LINE__ + 4;
+ my $PRE_STUB = <<END;
+{
+#line $lineno $file
+ INTVAL n_regs_used[] = { $n_regs_used };
+ opcode_t param_indexes[] = { $params_indexes };
+ opcode_t *return_indexes;
+ opcode_t *current_args;
+ PMC* type = pmc_new(interp, enum_class_FixedIntegerArray);
+ PMC* param_sig = Parrot_FixedIntegerArray_new_from_string(interp, type,
+ string_from_cstring(interp, $params_flags, 0), PObj_constant_FLAG);
+ PMC* return_sig = PMCNULL;
+ parrot_context_t *caller_ctx = CONTEXT(interp->ctx);
+ parrot_context_t *ctx = Parrot_push_context(interp, n_regs_used);
+ PMC *ccont = caller_ctx->current_cont;
+ opcode_t *pc;
+ struct call_state st;
+
+ current_args = interp->current_args;
+ interp->current_args = NULL;
+
+$named_names
+
+ Parrot_init_arg_op(interp, caller_ctx, current_args, &st.src);
+ Parrot_init_arg_indexes_and_sig_pmc(interp, ctx, param_indexes, param_sig, &st.dest);
+ Parrot_process_args(interp, &st, PARROT_PASS_PARAMS);
+
+ if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL) {
+ PObj_get_FLAGS(ccont) &= ~SUB_FLAG_TAILCALL;
+ --ctx->recursion_depth;
+ ctx->caller_ctx = caller_ctx->caller_ctx;
+ Parrot_free_context(interp, caller_ctx, 0);
+ interp->current_args = NULL;
+ }
+ /* BEGIN PARMS SCOPE */
+ {
+$params_accessors
+
+ /* BEGIN PMEHTOD BODY */
+END
+
+ my $method_returns = $self->{meth} . "_returns:";
+ $lineno = __LINE__ + 4;
+ my $POST_STUB = <<END;
+
+#line $lineno $file
+ goto no_return;
+ /* END PMEHTOD BODY */
+ $method_returns
+
+ //if (PMC_cont(ccont)->address) {
+ {
+ //parrot_context_t * const caller_ctx = PMC_cont(ccont)->to_ctx;
+ if (! caller_ctx) {
+ /* there is no point calling real_exception here, because
+ PDB_backtrace can't deal with a missing to_ctx either. */
+ internal_exception(1, "No caller_ctx for continuation \%p.", ccont);
+ }
+
+ Parrot_init_arg_indexes_and_sig_pmc(interp, ctx, return_indexes, return_sig, &st.src);
+ Parrot_init_arg_op(interp, caller_ctx, caller_ctx->current_results, &st.dest);
+ Parrot_process_args(interp, &st, PARROT_PASS_RESULTS);
+ }
+
+
+ /* END PARAMS SCOPE */
+ }
+ no_return:
+ PObj_live_CLEAR(type);
+ PObj_live_CLEAR(param_sig);
+ PObj_live_CLEAR(return_sig);
+ Parrot_pop_context(interp);
+END
+ ($self->{parameters}, $self->{pre_block}, $self->{post_block}) = ("", $PRE_STUB, $POST_STUB);
+ return;
+}
=head3 C<parse_flags()>
View
3  src/call_list.txt
@@ -346,6 +346,9 @@ I JOIP@
# other ParrotThread
P JO
+# src/pmc/nci.pmc
+v JOb
+
# --- start mysqlclient library ---
# Created from mysql.h using the following manual method:
# Edited copy of mysql.h using vi by doing g/, *$/j (repeat) then g/\* *$/j (repeat)
View
214 src/inter_call.c
@@ -74,6 +74,12 @@ Parrot_init_ret_nci(Interp *interp, struct call_state *st, const char *sig)
}
/*
+int
+=item C<Parrot_init_arg_indexes_and_sig_pmc(Interp *interp, parrot_context_t *ctx,
+ opcode_t *indexes, PMC* sig_pmc, struct call_state_item *st)>
+
+Initialize argument transfer with given context registers, register indexes, and
+a signature pmc.
=item C<int Parrot_init_arg_sig(Interp *, parrot_context_t *ctx,
const char *sig, void *ap, struct call_state_item *st)>
@@ -87,7 +93,7 @@ const_table), registers, function signature, and arguments.
Initialize argument transfer with given context registers, and opcode
location of a get_ or set_ argument opcode.
-Both functions can be used for either source or destination, by passing
+All functions can be used for either source or destination, by passing
either C<&st.src> or C<&st.dest> of a C<call_state> structure.
These functions return 0, if no arguments are present, or 1 on success.
@@ -97,23 +103,19 @@ These functions return 0, if no arguments are present, or 1 on success.
*/
int
-Parrot_init_arg_op(Interp *interp, parrot_context_t *ctx,
- opcode_t *pc, struct call_state_item *st)
+Parrot_init_arg_indexes_and_sig_pmc(Interp *interp, parrot_context_t *ctx,
+ opcode_t *indexes, PMC* sig_pmc, struct call_state_item *st)
{
- PMC *sig_pmc;
-
st->i = 0;
st->n = 0;
st->mode = CALL_STATE_OP;
st->ctx = ctx;
st->sig = 0;
- if (pc) {
- ++pc;
- sig_pmc = ctx->constants[*pc]->u.key;
+ if (indexes) {
ASSERT_SIG_PMC(sig_pmc);
st->u.op.signature = sig_pmc;
- st->u.op.pc = pc + 1;
+ st->u.op.pc = indexes;
st->n = SIG_ELEMS(sig_pmc);
/* initialize st->sig */
if (st->n)
@@ -124,6 +126,20 @@ Parrot_init_arg_op(Interp *interp, parrot_context_t *ctx,
}
int
+Parrot_init_arg_op(Interp *interp, parrot_context_t *ctx,
+ opcode_t *pc, struct call_state_item *st)
+{
+ PMC *sig_pmc = PMCNULL;
+ if (pc) {
+ ++pc;
+ sig_pmc = ctx->constants[*pc]->u.key;
+ ASSERT_SIG_PMC(sig_pmc);
+ ++pc;
+ }
+ return Parrot_init_arg_indexes_and_sig_pmc(interp, ctx, pc, sig_pmc, st);
+}
+
+int
Parrot_init_arg_sig(Interp *interp, parrot_context_t *ctx,
const char *sig, void *ap, struct call_state_item *st)
{
@@ -148,7 +164,7 @@ Parrot_init_arg_sig(Interp *interp, parrot_context_t *ctx,
* PMC being flattened, and fetch the first arg from the flattened set.
*/
static void
-make_flattened(Interp *interp, struct call_state *st, PMC *p_arg)
+start_flatten(Interp *interp, struct call_state *st, PMC *p_arg)
{
if (PARROT_ARG_NAME_ISSET(st->src.sig)) {
/* src ought to be an hash */
@@ -221,20 +237,7 @@ next_arg(Interp *interp, struct call_state_item *st)
static void
fetch_arg_sig(Interp *interp, struct call_state *st)
{
- va_list *ap;
-
- if (st->dest.mode & CALL_STATE_NEXT_ARG)
- next_arg(interp, &st->dest);
-
- if (!st->src.n)
- return;
-
- if (st->src.mode & CALL_STATE_NEXT_ARG) {
- if (!next_arg(interp, &st->src))
- return;
- }
-
- ap = (va_list*)(st->src.u.sig.ap);
+ va_list *ap = (va_list*)(st->src.u.sig.ap);
switch (st->src.sig & PARROT_ARG_TYPE_MASK) {
case PARROT_ARG_INTVAL:
UVal_int(st->val) = va_arg(*ap, INTVAL);
@@ -252,7 +255,7 @@ fetch_arg_sig(Interp *interp, struct call_state *st)
UVal_pmc(st->val) = va_arg(*ap, PMC*);
if (st->src.sig & PARROT_ARG_FLATTEN) {
- make_flattened(interp, st, UVal_pmc(st->val));
+ start_flatten(interp, st, UVal_pmc(st->val));
return;
}
break;
@@ -284,7 +287,7 @@ fetch_arg_op(Interp *interp, struct call_state *st)
: CTX_REG_PMC(st->src.ctx, idx);
if (st->src.sig & PARROT_ARG_FLATTEN) {
- make_flattened(interp, st, UVal_pmc(st->val));
+ start_flatten(interp, st, UVal_pmc(st->val));
return;
}
break;
@@ -493,7 +496,7 @@ clone_key_arg(Interp *interp, struct call_state *st)
* initializes dest calling state for recption of first named arg.
*/
static void
-init_named(Interp *interp, struct call_state *st)
+init_first_dest_named(Interp *interp, struct call_state *st)
{
int i, n_named, idx;
INTVAL sig;
@@ -510,10 +513,12 @@ init_named(Interp *interp, struct call_state *st)
st->dest.slurp = NULL;
st->dest.mode |= CALL_STATE_x_NAMED;
+ /* 1) count named args, make sure there is less than 32/64
+ * 2) create slurpy hash if needed */
for (i = st->dest.i; i < st->dest.n; ++i) {
sig = SIG_ITEM(st->dest.u.op.signature, i);
- /* skip the actual arg, only count the names of the named args */
+ /* skip the arg name, only count the actual args of the named args */
if (!(sig & PARROT_ARG_NAME))
continue;
/* slurpy named args, create slurpy hash */
@@ -523,11 +528,12 @@ init_named(Interp *interp, struct call_state *st)
idx = st->dest.u.op.pc[i];
CTX_REG_PMC(st->dest.ctx, idx) = st->dest.slurp;
}
- /* must be the name of a named arg, count it */
+ /* must be the actua arg of a named arg, count it */
else
n_named++;
}
+ /* only 32/64 named args allowed, an UINTVAL is used as a bitfield to detect duplicates */
if (n_named >= (int)(sizeof (UINTVAL) * 8))
real_exception(interp, NULL, E_ValueError, "Too many named arguments");
st->named_done = 0;
@@ -587,7 +593,8 @@ locate_named_named(Interp *interp, struct call_state *st)
}
n_named++;
idx = st->dest.u.op.pc[i];
- param = st->dest.ctx->constants[idx]->u.string;
+ param = PARROT_ARG_CONSTANT_ISSET(sig) ? st->dest.ctx->constants[idx]->u.string
+ : CTX_REG_STR(st->dest.ctx, idx);
if (st->name == param || 0 == string_equal(interp, st->name, param)) {
++i;
st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i);
@@ -703,45 +710,72 @@ null_val(int sig, struct call_state *st)
}
}
+/* check_named makes sure that all required named args are set and that
+ * all optional args and flags are set to null and false if not present.
+ * a named arg takes the form of
+ * STRING* name, [INPS] actual_arg,
+ * or
+ * STRING* name, [INPS] actual_arg, int opt_arg_flag
+ */
static void
check_named(Interp *interp, struct call_state *st, const char *action)
{
- int i, n_named, idx, was_set, n_i;
- INTVAL sig;
- STRING *param;
+ int i;
+ int n_named = -1;
- n_named = -1;
- was_set = n_i = 0;
for (i = st->first_named; i < st->dest.n; ++i) {
- st->dest.sig = sig = SIG_ITEM(st->dest.u.op.signature, i);
- if ((sig & PARROT_ARG_NAME)) {
+ INTVAL idx;
+
+ /* verify that a name exists */
+ INTVAL sig = st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i);
+ if(sig & PARROT_ARG_NAME)
+ {
+ INTVAL arg_sig;
+ int last_name_pos;
+ /* if slurpy then no errors, return */
if (sig & PARROT_ARG_SLURPY_ARRAY)
- break;
- was_set = 0;
+ return;
n_named++;
- n_i = i;
+ last_name_pos = i;
+
+ i++; /* move on to the actual arg */
+
+ /* verify that an actual arg exists */
+ arg_sig = st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i);
+ assert(!(arg_sig & PARROT_ARG_NAME));
+ /* if this named arg is already filled, continue*/
if (st->named_done & (1 << n_named)) {
- was_set = 1;
+ arg_sig = st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i+1);
+ if(arg_sig & PARROT_ARG_OPT_FLAG)
+ i++; /* skip associated opt flag arg as well */
+ continue;
+ }
+ else if (arg_sig & PARROT_ARG_OPTIONAL) {
+ null_val(arg_sig, st);
+ idx = st->dest.u.op.pc[i];
+ store_arg(st, idx);
+
+ arg_sig = st->dest.sig = SIG_ITEM(st->dest.u.op.signature, i+1);
+ if(arg_sig & PARROT_ARG_OPT_FLAG) {
+ i++;
+ idx = st->dest.u.op.pc[i];
+ CTX_REG_INT(st->dest.ctx, idx) = 0;
+ }
+ continue;
+ }
+ else {
+ idx = st->dest.u.op.pc[last_name_pos];
+ STRING *param = PARROT_ARG_CONSTANT_ISSET(sig)
+ ? st->dest.ctx->constants[idx]->u.string
+ : CTX_REG_STR(st->dest.ctx, idx);
+ real_exception(interp, NULL, E_ValueError,
+ "too few arguments passed - missing required named arg '%Ss'", param);
}
- continue;
- }
- if (was_set)
- continue;
- if (sig & PARROT_ARG_OPTIONAL) {
- null_val(sig, st);
- idx = st->dest.u.op.pc[i];
- store_arg(st, idx);
- continue;
}
- if (sig & PARROT_ARG_OPT_FLAG) {
- idx = st->dest.u.op.pc[i];
- CTX_REG_INT(st->dest.ctx, idx) = 0;
- continue;
+ else {
+ real_exception(interp, NULL, E_ValueError,
+ "invalid arg type in named portion of args");
}
- idx = st->dest.u.op.pc[n_i];
- param = st->dest.ctx->constants[idx]->u.string;
- real_exception(interp, NULL, E_ValueError,
- "too few arguments passed - missing required named arg '%Ss'", param);
}
}
@@ -756,17 +790,27 @@ init_call_stats(struct call_state *st)
st->first_named = -1;
}
-static void
-process_args(Interp *interp, struct call_state *st, const char *action, int err_check)
+void
+Parrot_process_args(Interp *interp, struct call_state *st, arg_pass_t param_or_result)
{
int state, opt_flag;
+ int err_check = 1;
+ const char *action = (param_or_result == PARROT_PASS_RESULTS) ? "results" : "params";
INTVAL idx;
+ if (param_or_result == PARROT_PASS_RESULTS) {
+ if (!PARROT_ERRORS_test(interp, PARROT_ERRORS_RESULT_COUNT_FLAG))
+ err_check = 0;
+ }
+ else {
+ if (!PARROT_ERRORS_test(interp, PARROT_ERRORS_PARAM_COUNT_FLAG))
+ err_check = 0;
+ }
+
if (!st->src.n)
st->dest.mode |= CALL_STATE_END_x;
if (!st->dest.n)
st->dest.mode |= CALL_STATE_x_END;
-
init_call_stats(st);
do {
@@ -821,7 +865,7 @@ process_args(Interp *interp, struct call_state *st, const char *action, int err_
/* first dest named arg, setup for recieving of named args */
if (!(state & CALL_STATE_x_NAMED) && (st->dest.sig & PARROT_ARG_NAME)) {
/* pos -> named dest */
- init_named(interp, st);
+ init_first_dest_named(interp, st);
}
state = st->dest.mode & CALL_STATE_MASK;
@@ -973,8 +1017,8 @@ Parrot_convert_arg(Interp *interp, struct call_state *st)
/*
=item C<opcode_t * parrot_pass_args(Interp *,
- parrot_context_t *src_ctx, parrot_context_t *dest_ctx,
- opcode_t *src_index, optcode_t *dest_index, int param_or_result)>
+ parrot_context_t *src_ctx, parrot_context_t *dest_ctx,
+ opcode_t *src_index, optcode_t *dest_index, arg_pass_t param_or_result)>
Main argument passing routine.
@@ -994,28 +1038,12 @@ the latter handles return values and yields.
void
parrot_pass_args(Interp *interp, parrot_context_t *src_ctx, parrot_context_t *dest_ctx,
- opcode_t *src_indexes, opcode_t *dest_indexes, int param_or_result)
+ opcode_t *src_indexes, opcode_t *dest_indexes, arg_pass_t param_or_result)
{
struct call_state st;
- int err_check = 1;
- const char *action = param_or_result ? "results" : "params";
- st.dest.n = 0; /* XXX */
-
- if (!dest_indexes)
- return;
-
Parrot_init_arg_op(interp, dest_ctx, dest_indexes, &st.dest);
Parrot_init_arg_op(interp, src_ctx, src_indexes, &st.src);
-
- if (param_or_result == PARROT_PASS_RESULTS) {
- if (!PARROT_ERRORS_test(interp, PARROT_ERRORS_RESULT_COUNT_FLAG))
- err_check = 0;
- }
- else {
- if (!PARROT_ERRORS_test(interp, PARROT_ERRORS_PARAM_COUNT_FLAG))
- err_check = 0;
- }
- process_args(interp, &st, action, err_check);
+ Parrot_process_args(interp, &st, param_or_result);
}
/*
@@ -1031,31 +1059,13 @@ Prerequsits are like above.
*/
opcode_t *
parrot_pass_args_fromc(Interp *interp, const char *sig,
- opcode_t *dest, parrot_context_t * old_ctxp, va_list ap)
-{
- if (dest[0] != PARROT_OP_get_params_pc) {
- /*
- * main is now started with runops_args_fromc too
- * PASM subs usually don't have get_params
- * XXX we could check, if we are running main
- */
- return dest;
- real_exception(interp, NULL, E_ValueError, "no get_params in sub");
- }
-
- return parrot_pass_args_to_result(interp, sig, dest, old_ctxp, ap);
-}
-
-opcode_t *
-parrot_pass_args_to_result(Interp *interp, const char *sig,
- opcode_t *dest, parrot_context_t * old_ctxp, va_list ap)
+ opcode_t *dest, parrot_context_t *old_ctxp, va_list ap)
{
struct call_state st;
Parrot_init_arg_op(interp, CONTEXT(interp->ctx), dest, &st.dest);
Parrot_init_arg_sig(interp, old_ctxp, sig, PARROT_VA_TO_VAPTR(ap), &st.src);
-
- process_args(interp, &st, "params", 1);
+ Parrot_process_args(interp, &st, PARROT_PASS_PARAMS);
return dest + st.dest.n + 2;
}
View
26 src/inter_misc.c
@@ -35,23 +35,31 @@ class C<type>.
=cut
*/
+void Parrot_NCI_make_raw_nci(Interp *interp, PMC *method, void *func);
void
-enter_nci_method(Parrot_Interp interp, int type,
- void *func, const char *name, const char *proto)
+enter_nci_method(Parrot_Interp interp, const int type, void *func, const char *name, const char *proto)
{
PMC * const method = pmc_new(interp, enum_class_NCI);
/* create call func */
VTABLE_set_pointer_keyed_str(interp, method,
- string_make(interp, proto, strlen(proto),
- NULL, PObj_constant_FLAG|PObj_external_FLAG),
+ string_make(interp, proto, strlen(proto), NULL, PObj_constant_FLAG|PObj_external_FLAG),
func);
/* insert it into namespace */
- VTABLE_set_pmc_keyed_str(interp,
- interp->vtables[type]->_namespace,
- string_make(interp, name,
- strlen(name), NULL,
- PObj_constant_FLAG|PObj_external_FLAG),
+ VTABLE_set_pmc_keyed_str(interp, interp->vtables[type]->_namespace,
+ string_make(interp, name, strlen(name), NULL, PObj_constant_FLAG|PObj_external_FLAG),
+ method);
+}
+
+void
+register_raw_nci_method_in_ns(Parrot_Interp interp, const int type, void *func, const char *name)
+{
+ PMC * const method = pmc_new(interp, enum_class_NCI);
+ /* setup call func */
+ Parrot_NCI_make_raw_nci(interp, method, func);
+ /* insert it into namespace */
+ VTABLE_set_pmc_keyed_str(interp, interp->vtables[type]->_namespace,
+ string_make(interp, name, strlen(name), NULL, PObj_constant_FLAG|PObj_external_FLAG),
method);
}
View
15 src/inter_run.c
@@ -21,6 +21,7 @@ Various functions that call the run loop.
#include <assert.h>
#include "parrot/parrot.h"
+#include "parrot/oplib/ops.h"
/*
@@ -183,10 +184,18 @@ runops_args(Parrot_Interp interp, PMC *sub, PMC *obj,
strcpy(new_sig + 1, sig + 1);
sig_p = new_sig;
}
- if (*sig_p) {
- dest = parrot_pass_args_fromc(interp, sig_p, dest,
- old_ctx, ap);
+
+ if (*sig_p && dest[0] == PARROT_OP_get_params_pc) {
+ dest = parrot_pass_args_fromc(interp, sig_p, dest, old_ctx, ap);
}
+ /*
+ * main is now started with runops_args_fromc too
+ * PASM subs usually don't have get_params
+ * XXX we could check, if we are running main
+ else {
+ real_exception(interp, NULL, E_ValueError, "no get_params in sub");
+ }
+ */
ctx = CONTEXT(interp->ctx);
offset = dest - interp->code->base.data;
View
2  src/pmc/exception_handler.pmc
@@ -30,7 +30,7 @@ pass_exception_args(Interp *interp, const char *sig,
va_list ap;
void *next;
va_start(ap, old_ctx);
- next = parrot_pass_args_to_result(interp, sig, dest, old_ctx, ap);
+ next = parrot_pass_args_fromc(interp, sig, dest, old_ctx, ap);
va_end(ap);
return next;
}
View
20 src/pmc/nci.pmc
@@ -23,7 +23,6 @@ The caller has to preserve registers if needed.
*/
#include "parrot/parrot.h"
-
pmclass NCI need_ext {
/*
@@ -42,6 +41,21 @@ Return the MMD signature PMC, if any or a Null PMC.
/*
+=item C<METHOD PMC* set_raw_nci_ptr(void *func)>
+
+Sets the specified function pointer and raw flag.
+
+=cut
+
+*/
+
+ METHOD void make_raw_nci(void *func) {
+ PMC_struct_val(SELF) = func;
+ PObj_flag_SET(private2, SELF);
+ }
+
+/*
+
=item C<void init()>
Initializes the NCI with a C<NULL> function pointer.
@@ -53,6 +67,7 @@ Initializes the NCI with a C<NULL> function pointer.
void init() {
PMC_struct_val(SELF) = NULL;
PMC_pmc_val(SELF) = NULL;
+ PObj_flag_CLEAR(private2, SELF);
}
/*
@@ -137,7 +152,8 @@ shifted down.
void* invoke(void * next) {
typedef INTVAL(*nci_sub_t)(Interp * , PMC * );
- nci_sub_t func = (nci_sub_t)D2FPTR(PMC_data(SELF));
+ nci_sub_t func = PObj_flag_TEST(private2, SELF) ? PMC_struct_val(SELF)
+ : (nci_sub_t)D2FPTR(PMC_data(SELF));
PMC *cont;
if (!func)
View
98 src/pmc/pmethod_test.pmc
@@ -0,0 +1,98 @@
+/*
+Copyright (C) 2001-2006, The Perl Foundation.
+$Id: hash.pmc 15414 2006-11-12 02:47:59Z chip $
+
+=head1 NAME
+
+src/pmc/pmethod_test.pmc - PMETHOD_Test PMC
+
+=head1 DESCRIPTION
+
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+#include <assert.h>
+#include <pmc_fixedintegerarray.h>
+
+
+/* Albeit the Hash PMC doesn't use PMC_data, it needs the next_for_GC pointer
+ * We would get recursive marking of a deeply nested HoHoH...
+ */
+pmclass PMETHOD_Test need_ext does hash {
+
+/*
+
+=item C<void init()>
+
+Initializes the instance.
+
+=item C<void destroy()>
+
+Free hash structure.
+
+=cut
+
+=item C<void mark()>
+
+Marks the hash as live.
+
+=cut
+
+*/
+
+ METHOD void test_method ()
+ {
+ PIO_printf(interp, "test_method\n");
+ }
+ PMETHOD void test_method0( int a1 )
+ {
+ PIO_printf(interp, "test_method0\n");
+ PIO_printf(interp, "%d\n", a1);
+ }
+ PMETHOD void test_method1( int a1, int a2, int a3, int a4, int a5, int a6)
+ {
+ PIO_printf(interp, "test_method1\n");
+ PIO_printf(interp, "%d,%d,%d,%d,%d,%d\n", a1, a2, a3, a4, a5, a6);
+ }
+ PMETHOD void test_method2( int a1 :optional, int a1o :opt_flag, PMC *slurpy_pos :slurpy)
+ {
+ STRING* kevin = string_from_cstring(interp, "KEVIN", 0);
+ PIO_printf(interp, "test_method2\n");
+ PIO_printf(interp, "%d, %d, %Ss %Ss\n", a1, a1o, VTABLE_name(interp, slurpy_pos), VTABLE_get_repr(interp,slurpy_pos));
+
+ preturn(int 1000, STRING* kevin);
+ }
+ PMETHOD void test_method3(PMC* a1 :named["a1name"], PMC* a2 :named["a2name"])
+ {
+ PIO_printf(interp, "test_method3\n");
+ PIO_printf(interp, "%Ps, %Ps\n", a1, a2);
+ }
+ PMETHOD void test_method4( int george :optional, int g_f :opt_flag, PMC *slurpy_pos :slurpy, PMC *slurpy_named :slurpy :named )
+ {
+ PIO_printf(interp, "test_method4\n");
+ }
+}
+
+/*
+
+=back
+
+=head1 SEE ALSO
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
View
26 src/pmc/resizablepmcarray.pmc
@@ -629,6 +629,32 @@ Append the other array to this array.
}
}
}
+/*
+
+=item C<STRING *get_repr()>
+
+Returns the Parrot string representation C<ResizablePMCArray>.
+
+=cut
+
+*/
+
+ STRING* get_repr() {
+ STRING *res;
+ INTVAL j, n;
+ PMC *val;
+
+ res = string_from_cstring(INTERP, "[ ", 0);
+ n = VTABLE_elements(INTERP, SELF);
+ for (j = 0; j < n; ++j) {
+ val = SELF.get_pmc_keyed_int(j);
+ res = string_append(INTERP, res, VTABLE_get_repr(INTERP, val));
+ if (j < n - 1)
+ res = string_append(INTERP, res, const_string(INTERP, ", "));
+ }
+ res = string_append(INTERP, res, const_string(INTERP, " ]"));
+ return res;
+ }
/*
View
75 t/pmc/pmethod_test.t
@@ -0,0 +1,75 @@
+#!perl
+# Copyright (C) 2006, The Perl Foundation.
+# $Id: pmethod_test.t 16171 2006-12-17 19:06:36Z paultcochrane $
+
+use strict;
+use warnings;
+use lib qw( . lib ../lib ../../lib );
+use Test::More;
+use Parrot::Test tests => 2;
+
+=head1 NAME
+
+t/pmc/pmethod_test.t - test the PMETHOD_Test PMC
+
+
+=head1 SYNOPSIS
+
+ % prove t/pmc/pmethod_test.t
+
+=head1 DESCRIPTION
+
+Tests the PMETHOD_Test PMC.
+
+=cut
+
+pir_output_is( <<'CODE', <<'OUT', 'named args' );
+.sub main :main
+ $P0 = new 'PMETHOD_Test'
+ $P0.'test_method3'( 'a1name' => 10, 'a2name' => 20 )
+.end
+CODE
+test_method3
+10, 20
+OUT
+
+pir_output_is( <<'CODE', <<'OUT', 'optional args and multiple returns' );
+.sub main :main
+ $P0 = new 'PMETHOD_Test'
+ $P0.'test_method0'(1)
+ $P0.'test_method1'(1, 2, 3, 4, 5, 6)
+ $P0.'test_method2'()
+ $P0.'test_method2'(1)
+ $P0.'test_method2'(1,2)
+ $P0.'test_method2'(1,2,3)
+ ($P1,$P2) = $P0.'test_method2'(101)
+ print "BACK - "
+ print $P1
+ print " - "
+ print $P2
+ print " -\n"
+.end
+CODE
+test_method0
+1
+test_method1
+1,2,3,4,5,6
+test_method2
+0, 0, ResizablePMCArray [ ]
+test_method2
+1, 1, ResizablePMCArray [ ]
+test_method2
+1, 1, ResizablePMCArray [ 2 ]
+test_method2
+1, 1, ResizablePMCArray [ 2, 3 ]
+test_method2
+101, 1, ResizablePMCArray [ ]
+BACK - 1000 - KEVIN -
+OUT
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Please sign in to comment.
Something went wrong with that request. Please try again.