cvsuser 04/04/30 09:05:47
Modified: build_tools build_nativecall.pl
docs/pdds pdd16_native_call.pod
jit/i386 jit_emit.h
src call_list.txt nci_test.c
t/pmc nci.t
Log:
[perl #29261] [PATCH Wrap Out Parameters in PMCs]
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
INTVAL PMCs.
Courtesy of Chromatic <[EMAIL PROTECTED]>
Plus:
* JIT/i386 changed
* docs
Revision Changes Path
1.47 +8 -8 parrot/build_tools/build_nativecall.pl
Index: build_nativecall.pl
===================================================================
RCS file: /cvs/public/parrot/build_tools/build_nativecall.pl,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -w -r1.46 -r1.47
--- build_nativecall.pl 23 Apr 2004 09:20:13 -0000 1.46
+++ build_nativecall.pl 30 Apr 2004 16:05:34 -0000 1.47
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: build_nativecall.pl,v 1.46 2004/04/23 09:20:13 jrieks Exp $
+# $Id: build_nativecall.pl,v 1.47 2004/04/30 16:05:34 leo Exp $
=head1 NAME
@@ -160,7 +160,7 @@
/* nci.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: build_nativecall.pl,v 1.46 2004/04/23 09:20:13 jrieks Exp $
+ * $Id: build_nativecall.pl,v 1.47 2004/04/30 16:05:34 leo Exp $
* Overview:
* Native Call Interface routines. The code needed to build a
* parrot to C call frame is in here
@@ -292,14 +292,14 @@
/i/ && do {my $regnum = $reg_ref->{i}++;
return "(int)REG_INT($regnum)";
};
- /3/ && do {my $regnum = $reg_ref->{i}++;
- return "(int*)®_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)";
};
- /4/ && do {my $regnum = $reg_ref->{i}++;
- return "(long*)®_INT($regnum)";
+ /4/ && do {my $regnum = $reg_ref->{p}++;
+ return "(long*)&PMC_int_val(REG_PMC($regnum))";
};
/s/ && do {my $regnum = $reg_ref->{i}++;
return "(short)REG_INT($regnum)";
@@ -307,8 +307,8 @@
/c/ && do {my $regnum = $reg_ref->{i}++;
return "(char)REG_INT($regnum)";
};
- /2/ && do {my $regnum = $reg_ref->{i}++;
- return "(short*)®_INT($regnum)";
+ /2/ && do {my $regnum = $reg_ref->{p}++;
+ return "(short*)&PMC_int_val(REG_PMC($regnum))";
};
/f/ && do {my $regnum = $reg_ref->{n}++;
return "(float)REG_NUM($regnum)";
1.9 +25 -18 parrot/docs/pdds/pdd16_native_call.pod
Index: pdd16_native_call.pod
===================================================================
RCS file: /cvs/public/parrot/docs/pdds/pdd16_native_call.pod,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- pdd16_native_call.pod 28 Apr 2004 10:06:13 -0000 1.8
+++ pdd16_native_call.pod 30 Apr 2004 16:05:37 -0000 1.9
@@ -1,5 +1,5 @@
# Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-# $Id: pdd16_native_call.pod,v 1.8 2004/04/28 10:06:13 leo Exp $
+# $Id: pdd16_native_call.pod,v 1.9 2004/04/30 16:05:37 leo Exp $
=head1 NAME
@@ -75,18 +75,6 @@
long. An integer type. You know the drill.
-=item 2
-
-A pointer to a short, taken from an I register.
-
-=item 3
-
-A pointer to an int, taken from an I register.
-
-=item 4
-
-A pointer to a long, taken from an I register.
-
=item f
float. F register denizen.
@@ -95,6 +83,10 @@
double. F register, double-precision floating point type
+=item P
+
+A PMC register.
+
=item p
PMC thingie. A generic pointer, taken from or stuck into a PMC's
@@ -102,6 +94,21 @@
UnManagedStruct PMC type, which is just a generic "pointer so some
damn thing or other" PMC type which Parrot does I<no> management of.
+=item 2
+
+A pointer to a short, taken from an P register of an int-like PMC.
+On return from NCI, the PMC_int_val will hold the new value.
+
+=item 3
+
+A pointer to an int, taken from an P register of an int-like PMC.
+On return from NCI, the PMC_int_val will hold the new value.
+
+=item 4
+
+A pointer to a long, taken from an P register of an int-like PMC.
+On return from NCI, the PMC_int_val will hold the new value.
+
=item t
string pointer. Taken from, or stuck into, a string
1.113 +11 -7 parrot/jit/i386/jit_emit.h
Index: jit_emit.h
===================================================================
RCS file: /cvs/public/parrot/jit/i386/jit_emit.h,v
retrieving revision 1.112
retrieving revision 1.113
diff -u -w -r1.112 -r1.113
--- jit_emit.h 29 Apr 2004 17:40:02 -0000 1.112
+++ jit_emit.h 30 Apr 2004 16:05:40 -0000 1.113
@@ -3,7 +3,7 @@
*
* i386
*
- * $Id: jit_emit.h,v 1.112 2004/04/29 17:40:02 leo Exp $
+ * $Id: jit_emit.h,v 1.113 2004/04/30 16:05:40 leo Exp $
*/
#if !defined(PARROT_I386_JIT_EMIT_H_GUARD)
@@ -2806,9 +2806,9 @@
count_regs(char *sig, char *sig_start)
{
const char *typs[] = {
- "lisc234", /* I */
+ "lisc", /* I */
"tbB", /* S */
- "pP", /* P */
+ "pP234", /* P */
"fd" /* N */
};
int first_reg = 5;
@@ -2868,8 +2868,12 @@
case '3':
case '4':
/* This might be right. Or not... */
- jit_emit_mov_ri_i(pc, emit_EAX,
- &INT_REG(count_regs(sig, signature->strstart)));
+ /* we need the offset of PMC_int_val */
+ jit_emit_mov_rm_i(pc, emit_EDX,
+ &PMC_REG(count_regs(sig, signature->strstart)));
+ //emitm_movl_m_r(pc, emit_EAX, emit_EDX, 0, 1,
+ emitm_lea_m_r (pc, emit_EAX, emit_EDX, 0, 1,
+ (size_t) &PMC_int_val((PMC *) 0));
emitm_pushl_r(pc, emit_EAX);
break;
case 'f':
1.31 +7 -6 parrot/src/call_list.txt
Index: call_list.txt
===================================================================
RCS file: /cvs/public/parrot/src/call_list.txt,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -w -r1.30 -r1.31
--- call_list.txt 28 Apr 2004 10:06:17 -0000 1.30
+++ call_list.txt 30 Apr 2004 16:05:43 -0000 1.31
@@ -6,9 +6,6 @@
# s - short
# i - int
# l - long
-# 2 - pointer to short
-# 3 - pointer to int
-# 4 - pointer to long
# NUM reg stuff
# f - float
# d - double
@@ -17,10 +14,13 @@
# PMC reg stuff
# p - data pointer from PMC (on store into a new UnManagedStruct PMC)
# P - pointer to a PMC-register
-# O - pointer to PMC-regise 2 (object)
+# O - pointer to PMC-register #2 (object)
+# 2 - pointer to short
+# 3 - pointer to int
+# 4 - pointer to long
# void stuff
# v - void
-# P - void *
+# b - void *
# B - void **
# special stuff
@@ -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
1.24 +9 -0 parrot/src/nci_test.c
Index: nci_test.c
===================================================================
RCS file: /cvs/public/parrot/src/nci_test.c,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -w -r1.23 -r1.24
--- nci_test.c 28 Apr 2004 10:06:17 -0000 1.23
+++ nci_test.c 30 Apr 2004 16:05:43 -0000 1.24
@@ -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
1.37 +49 -6 parrot/t/pmc/nci.t
Index: nci.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/nci.t,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -w -r1.36 -r1.37
--- nci.t 28 Apr 2004 10:06:29 -0000 1.36
+++ nci.t 30 Apr 2004 16:05:47 -0000 1.37
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: nci.t,v 1.36 2004/04/28 10:06:29 leo Exp $
+# $Id: nci.t,v 1.37 2004/04/30 16:05:47 leo Exp $
=head1 NAME
@@ -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";
@@ -343,8 +343,9 @@
output_is(<<'CODE', <<'OUTPUT', "nci_i_4i");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_i4i", "i4i"
- set I5, 6
- set I6, 7
+ new P5, .PerlInt
+ set P5, 6
+ set I5, 7
invoke
print I5
print "\n"
@@ -354,14 +355,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 +1103,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
