[perl #29261] [PATCH Wrap Out Parameters in PMCs]

[via RT]

# New Ticket Created by  chromatic 
# Please include the string:  [perl #29261]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org:80/rt3/Ticket/Display.html?id=29261 >


Following up on the idea Leo and I discussed this morning, here's a
patch that expects integer out parameters to be wrapped in some sort of
INTVALy PMCs.

This solves my problem rather nicely.

One test in t/pmc/nci.t needed patching and I added a test.

If this is acceptable, we should do the same for float and string out
parameters too.

Please note that this only affects integers passed to NCI subs via
pointers.

-- c



Index: t/pmc/nci.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/nci.t,v
retrieving revision 1.36
diff -u -u -r1.36 nci.t
--- t/pmc/nci.t	28 Apr 2004 10:06:29 -0000	1.36
+++ t/pmc/nci.t	30 Apr 2004 02:45:09 -0000
@@ -17,7 +17,7 @@
 
 =cut
 
-use Parrot::Test tests => 30;
+use Parrot::Test tests => 31;
 use Parrot::Config;
 
 print STDERR $PConfig{jitcpuarch}, " JIT CPU\n";
@@ -354,14 +354,22 @@
 OUTPUT
 
 output_is(<<'CODE', <<'OUTPUT', "nci_i_i3");
+.include "datatypes.pasm"
   loadlib P1, "libnci"
   dlfunc P0, P1, "nci_ii3", "ii3"
   set I5, 6
-  set I6, 7
+
+  new P5, .PerlInt
+  set P5, 7
+
+  set I0, 1
+  set I1, 1
+  set I3, 1
   invoke
+
   print I5
   print "\n"
-  print I6
+  print P5
   print "\n"
   end
 CODE
@@ -1094,6 +1102,40 @@
 Y: 410
 W: 420
 H: 430
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', 'out parameters and return values');
+
+.include "datatypes.pasm"
+  new P2, .PerlInt
+  set P2, 3
+  new P3, .PerlInt
+  set P3, 2
+
+  set P5, P2
+  set P6, P3
+
+  set I0, 1
+  set I2, 0
+  set I3, 2
+  set I4, 0
+  loadlib P1, "libnci"
+  dlfunc P0, P1, "nci_i_33", "i33"
+  invoke
+
+  print "Double: "
+  print P2
+  print "\nTriple: "
+  print P3
+  print "\nSum: "
+  print I5
+  print "\n"
+
+  end
+CODE
+Double: 6
+Triple: 6
+Sum: 12
 OUTPUT
 
 } # SKIP
Index: src/nci_test.c
===================================================================
RCS file: /cvs/public/parrot/src/nci_test.c,v
retrieving revision 1.23
diff -u -u -r1.23 nci_test.c
--- src/nci_test.c	28 Apr 2004 10:06:17 -0000	1.23
+++ src/nci_test.c	30 Apr 2004 02:45:09 -0000
@@ -35,6 +35,7 @@
 } Rect_Like;
 
 void nci_pip (int count, Rect_Like *rects);
+int nci_i_33 (int *double_me, int *triple_me);
 
 double nci_dd(double d) {
     return d * 2.0;
@@ -272,6 +273,14 @@
     for (i = 0; i < 4; ++i)
         printf("X: %d\nY: %d\nW: %d\nH: %d\n",
 		rects[i].x, rects[i].y, rects[i].w, rects[i].h );
+}
+
+int nci_i_33 (int *double_me, int *triple_me)
+{
+	*double_me *= 2;
+	*triple_me *= 3;
+
+	return( *double_me + *triple_me );
 }
 
 #ifdef TEST
Index: build_tools/build_nativecall.pl
===================================================================
RCS file: /cvs/public/parrot/build_tools/build_nativecall.pl,v
retrieving revision 1.46
diff -u -u -r1.46 build_nativecall.pl
--- build_tools/build_nativecall.pl	23 Apr 2004 09:20:13 -0000	1.46
+++ build_tools/build_nativecall.pl	30 Apr 2004 02:45:09 -0000
@@ -292,8 +292,8 @@
     /i/ && do {my $regnum = $reg_ref->{i}++;
 	       return "(int)REG_INT($regnum)";
               };
-    /3/ && do {my $regnum = $reg_ref->{i}++;
-	       return "(int*)&REG_INT($regnum)";
+    /3/ && do {my $regnum = $reg_ref->{p}++;
+	       return "(int*)&PMC_int_val(REG_PMC($regnum))";
               };
     /l/ && do {my $regnum = $reg_ref->{i}++;
 	       return "(long)REG_INT($regnum)";
Index: src/call_list.txt
===================================================================
RCS file: /cvs/public/parrot/src/call_list.txt,v
retrieving revision 1.30
diff -u -u -r1.30 call_list.txt
--- src/call_list.txt	28 Apr 2004 10:06:17 -0000	1.30
+++ src/call_list.txt	30 Apr 2004 02:46:15 -0000
@@ -206,10 +206,11 @@
 i	pPtiiipi
 i	tpiibi
 
-# Used by library/sdl.imc
+# Used by SDL
 p	iiil
 i	ppl
 
 # used by t/pmc/nci.t
 v	pP
 p	ip
+i	33