[svn:parrot] r43631 - trunk/tools/build
plobsing at svn.parrot.org
plobsing at svn.parrot.org
Wed Jan 27 22:36:58 UTC 2010
Author: plobsing
Date: Wed Jan 27 22:36:56 2010
New Revision: 43631
URL: https://trac.parrot.org/parrot/changeset/43631
Log:
small simplifications to nativecall.pl
Modified:
trunk/tools/build/nativecall.pl
Modified: trunk/tools/build/nativecall.pl
==============================================================================
--- trunk/tools/build/nativecall.pl Wed Jan 27 18:56:38 2010 (r43630)
+++ trunk/tools/build/nativecall.pl Wed Jan 27 22:36:56 2010 (r43631)
@@ -41,7 +41,7 @@
my %sig_table = (
p => {
as_proto => "void *",
- other_decl => "PMC * final_destination = PMCNULL;",
+ final_dest => "PMC * final_destination = PMCNULL;",
sig_char => "P",
ret_assign => "if (return_data != NULL) {\n" .
" final_destination = pmc_new(interp, enum_class_UnManagedStruct);\n" .
@@ -56,7 +56,7 @@
f => { as_proto => "float", sig_char => "N", return_type => "FLOATVAL" },
d => { as_proto => "double", sig_char => "N", return_type => "FLOATVAL" },
t => { as_proto => "char *",
- other_decl => "STRING *final_destination;",
+ final_dest => "STRING *final_destination;",
ret_assign => "final_destination = Parrot_str_new(interp, return_data, 0);\n Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"S\", final_destination);",
sig_char => "S" },
v => { as_proto => "void",
@@ -152,7 +152,7 @@
$sig, $ret,
$args, [@arg],
$ret_sig->{as_return}, $ret_sig->{return_type_decl},
- $ret_sig->{func_call_assign}, $ret_sig->{other_decl},
+ $ret_sig->{func_call_assign}, $ret_sig->{final_dest},
$ret_sig->{ret_assign}, \@temps,
\@fill_params, \@extra_preamble, \@extra_postamble,
\@put_pointer_nci_too,
@@ -163,7 +163,7 @@
$sig, $ret,
$args, [@arg],
$ret_sig->{as_return}, $ret_sig->{return_type_decl},
- $ret_sig->{func_call_assign}, $ret_sig->{other_decl},
+ $ret_sig->{func_call_assign}, $ret_sig->{final_dest},
$ret_sig->{ret_assign}, \@temps,
\@fill_params, \@extra_preamble, \@extra_postamble,
\@put_pointer,
@@ -258,6 +258,12 @@
local $_ = $argtype;
my $temp_num = ${$temp_cnt_ref}++;
+ /[ilcsfdINSOP\@]/ && 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";
+ };
/p/ && do {
push @{$temps_ref}, "PMC *t_$temp_num;";
push @{$fill_params_ref}, "&t_$temp_num";
@@ -271,28 +277,6 @@
push @{$extra_postamble_ref}, "VTABLE_set_pointer(interp, t_$temp_num, v_$temp_num);";
return "&v_$temp_num";
};
- /[INS]/ && do {
- my $ret_type = $sig_table{$_}{return_type};
- push @{$temps_ref}, "$ret_type t_$temp_num;";
- push @{$fill_params_ref}, "&t_$temp_num";
- return "t_$temp_num";
- };
- /[ilcs]/ && do {
- my $ret_type = $sig_table{$_}{return_type};
- push @{$temps_ref}, "$ret_type t_$temp_num;";
- push @{$temps_ref}, "INTVAL ti_$temp_num;";
- push @{$fill_params_ref}, "&ti_$temp_num";
- push @{$extra_preamble_ref}, "t_$temp_num = ($ret_type)ti_$temp_num;";
- return "t_$temp_num";
- };
- /[fd]/ && do {
- 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;";
@@ -329,27 +313,22 @@
/J/ && do {
return "interp";
};
- /[OP\@]/ && do {
- push @{$temps_ref}, "PMC *t_$temp_num;";
- push @{$fill_params_ref}, "&t_$temp_num";
- return "t_$temp_num";
- };
return;
}
sub create_function {
my (
$sig, $return, $params, $args,
- $ret_type, $ret_type_decl, $return_assign, $other_decl,
+ $ret_type, $ret_type_decl, $return_assign, $final_dest,
$final_assign, $temps_ref, $fill_params_ref, $extra_preamble_ref,
$extra_postamble_ref, $put_pointer_ref,
) = @_;
my $func = '';
- $other_decl ||= "";
+ $final_dest ||= "";
- $other_decl .= join( "\n ", @{$temps_ref} );
+ my $other_decl .= join( "\n ", $final_dest, @{$temps_ref} );
my $call_object_decl = <<"CALLOBJECT";
PMC *ctx = CURRENT_CONTEXT(interp);
PMC *call_object = Parrot_pcc_get_signature(interp, ctx);
More information about the parrot-commits
mailing list