cvsuser 04/08/09 14:20:12
Modified: build_tools build_nativecall.pl
Log:
Things like this
(int*)&something_not_int
just aren't cool. The attached patch does a horrible hack for
build_nativecall.pl to introduce the necessary temp variables.
With this patch IRIX64 is now passing all but one of the nci.t.
A separate report on that will follow.
Courtesy of Jarkko "The Man" Hietaniemi <[EMAIL PROTECTED]>
Revision Changes Path
1.49 +31 -10 parrot/build_tools/build_nativecall.pl
Index: build_nativecall.pl
===================================================================
RCS file: /cvs/public/parrot/build_tools/build_nativecall.pl,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -w -r1.48 -r1.49
--- build_nativecall.pl 8 Jul 2004 16:11:30 -0000 1.48
+++ build_nativecall.pl 9 Aug 2004 21:20:12 -0000 1.49
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: build_nativecall.pl,v 1.48 2004/07/08 16:11:30 leo Exp $
+# $Id: build_nativecall.pl,v 1.49 2004/08/09 21:20:12 dan Exp $
=head1 NAME
@@ -165,7 +165,7 @@
/* nci.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: build_nativecall.pl,v 1.48 2004/07/08 16:11:30 leo Exp $
+ * $Id: build_nativecall.pl,v 1.49 2004/08/09 21:20:12 dan Exp $
* Overview:
* Native Call Interface routines. The code needed to build a
* parrot to C call frame is in here
@@ -223,7 +223,7 @@
}
# Header
- generate_func_header($ret, $args, (join ",", @arg), $ret_type{$ret},
+ generate_func_header($ret, $args, [EMAIL PROTECTED], $ret_type{$ret},
$ret_type_decl{$ret}, $func_call_assign{$ret},
$other_decl{$ret}, $ret_assign{$ret});
@@ -375,7 +375,7 @@
}
sub generate_func_header {
- my ($return, $params, $call_params, $ret_type, $ret_type_decl,
+ my ($return, $params, $args, $ret_type, $ret_type_decl,
$return_assign, $other_decl, $final_assign) = @_;
$other_decl ||= "";
@@ -383,18 +383,39 @@
my $proto = join ', ', map { $proto_type{$_} } split '', $params;
$extra_preamble = join("", @extra_preamble);
$extra_postamble = join("", @extra_postamble);
+ # This is an after-the-fact hack: real fix would be in make_arg
+ # or somewhere at that level. The main point being that one cannot
+ # just cast pointers and expect things to magically align. Instead
+ # of trying to: (int*)&something_not_int, one HAS to use temporary
+ # variables. We detect and collect those to "temp".
+ my @temp;
+ for my $i (0..$#$args) {
+ if ($args->[$i] =~ /^\((.+)\*\)&(.+)$/) {
+ $temp[$i] = [ $1, $2 ];
+ $args->[$i] = "&arg$i";
+ }
+ }
+ my $call_params = join(",", @$args);
+ my @tempi = grep { defined $temp[$_] } 0..$#$args;
+ my $temp_decl = join("\n ", map { "$temp[$_]->[0] arg$_;"} @tempi);
+ my $temp_in = join("\n ", map { "arg$_ = $temp[$_]->[1];"} @tempi);
+ my $temp_out = join("\n ", map { "$temp[$_]->[1] = arg$_;"} @tempi);
+ $return_data = "$return_assign $final_assign" =~ /return_data/ ?
"$ret_type_decl return_data;" : "";
print NCI <<HEADER;
static void
pcf_${return}_$params(Interp *interpreter, PMC *self)
{
typedef $ret_type (*func_t)($proto);
func_t pointer;
- $ret_type_decl return_data;
+ $return_data
+ $temp_decl
$other_decl
$extra_preamble
pointer = (func_t)D2FPTR(PMC_struct_val(self));
+ $temp_in
$return_assign ($ret_type)(*pointer)($call_params);
+ $temp_out
$final_assign
$extra_postamble
HEADER
@@ -405,7 +426,7 @@
pcf_${return}(Interp *interpreter, PMC *self)
{
$ret_type (*pointer)(void);
- $ret_type_decl return_data;
+ $return_data
$other_decl
$extra_preamble
