cvsuser 03/10/29 01:18:31
Modified: build_tools build_nativecall.pl
config/gen/makefiles root.in
lib/Parrot Test.pm
. libnci.def
src call_list.txt nci_test.c
t/pmc nci.t
Log:
null PMCs with native NCI; test; use existing register macros
Revision Changes Path
1.29 +42 -51 parrot/build_tools/build_nativecall.pl
Index: build_nativecall.pl
===================================================================
RCS file: /cvs/public/parrot/build_tools/build_nativecall.pl,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -w -r1.28 -r1.29
--- build_nativecall.pl 23 Oct 2003 19:54:03 -0000 1.28
+++ build_nativecall.pl 29 Oct 2003 09:18:19 -0000 1.29
@@ -4,6 +4,7 @@
my %ret_count;
%ret_count = (p => [0,0,0,1,0], # Returning a pointer that we PMC stuff
+ P => [0,0,0,1,0], # PMC
i => [0,1,0,0,0], # Returning an int
3 => [0,1,0,0,0], # Returning an int pointer
l => [0,1,0,0,0], # Returning a long
@@ -32,6 +33,7 @@
v => "void",
# b => "void *",
# B => "void **",
+# P => "void *",
);
my (%proto_type) = (p => "void *",
@@ -72,22 +74,23 @@
v => "void *",
# b => "void *",
# B => "void **",
+# P => "void *",
);
-my (%ret_assign) = (p => "PMC_data(final_destination) = return_data;\nPMC_REG(5) =
final_destination;",
- i => "INT_REG(5) = return_data;",
- 3 => "INT_REG(5) = *return_data;",
- l => "INT_REG(5) = return_data;",
- 4 => "INT_REG(5) = *return_data;",
- c => "INT_REG(5) = return_data;",
- 2 => "INT_REG(5) = *return_data;",
- f => "NUM_REG(5) = return_data;",
- d => "NUM_REG(5) = return_data;",
+my (%ret_assign) = (p => "PMC_data(final_destination) = return_data;\nREG_PMC(5) =
final_destination;",
+ i => "REG_INT(5) = return_data;",
+ 3 => "REG_INT(5) = *return_data;",
+ l => "REG_INT(5) = return_data;",
+ 4 => "REG_INT(5) = *return_data;",
+ c => "REG_INT(5) = return_data;",
+ 2 => "REG_INT(5) = *return_data;",
+ f => "REG_NUM(5) = return_data;",
+ d => "REG_NUM(5) = return_data;",
v => "",
- t => "final_destination = string_from_cstring(interpreter,
return_data, 0);\nSTR_REG(5) = final_destination;",
-# b => "final_destination->bufstart = return_data;\nSTR_REG(5) =
final_destination",
-# B => "final_destination->bufstart = *return_data;\nSTR_REG(5) =
final_destination",
- s => "INT_REG(5) = return_data;",
+ t => "final_destination = string_from_cstring(interpreter,
return_data, 0);\nREG_STR(5) = final_destination;",
+# b => "final_destination->bufstart = return_data;\nREG_STR(5) =
final_destination",
+# B => "final_destination->bufstart = *return_data;\nREG_STR(5) =
final_destination",
+ s => "REG_INT(5) = return_data;",
);
my (%func_call_assign) = (p => "return_data = ",
@@ -102,6 +105,7 @@
d => "return_data = ",
b => "return_data = ",
t => "return_data = ",
+ P => "return_data = ",
# B => "return_data = ",
v => "",
);
@@ -121,7 +125,7 @@
/* nci.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: build_nativecall.pl,v 1.28 2003/10/23 19:54:03 dan Exp $
+ * $Id: build_nativecall.pl,v 1.29 2003/10/29 09:18:19 leo Exp $
* Overview:
* Native Call Interface routines. The code needed to build a
* parrot to C call frame is in here
@@ -133,19 +137,6 @@
#include "parrot/parrot.h"
-#if !defined(INT_REG)
-# define INT_REG(x) interpreter->int_reg.registers[x]
-#endif
-#if !defined(NUM_REG)
-# define NUM_REG(x) interpreter->num_reg.registers[x]
-#endif
-#if !defined(STR_REG)
-# define STR_REG(x) interpreter->string_reg.registers[x]
-#endif
-#if !defined(PMC_REG)
-# define PMC_REG(x) interpreter->pmc_reg.registers[x]
-#endif
-
#if defined(HAS_JIT) && defined(I386)
# include "parrot/exec.h"
# include "parrot/jit.h"
@@ -159,11 +150,11 @@
static void
set_return_val(struct Parrot_Interp *interpreter, int stack, int ints,
int strings, int pmcs, int nums) {
- INT_REG(0) = stack;
- INT_REG(1) = ints;
- INT_REG(2) = strings;
- INT_REG(3) = pmcs;
- INT_REG(4) = nums;
+ REG_INT(0) = stack;
+ REG_INT(1) = ints;
+ REG_INT(2) = strings;
+ REG_INT(3) = pmcs;
+ REG_INT(4) = nums;
}
HEAD
@@ -232,49 +223,49 @@
sub make_arg {
my ($argtype, $reg_ref) = @_;
/p/ && do {my $regnum = $reg_ref->{p}++;
- return "PMC_data(PMC_REG($regnum))";
+ return "PMC_data(REG_PMC($regnum))";
};
/i/ && do {my $regnum = $reg_ref->{i}++;
- return "(int)INT_REG($regnum)";
+ return "(int)REG_INT($regnum)";
};
/3/ && do {my $regnum = $reg_ref->{i}++;
- return "(int*)&INT_REG($regnum)";
+ return "(int*)®_INT($regnum)";
};
/l/ && do {my $regnum = $reg_ref->{i}++;
- return "(long)INT_REG($regnum)";
+ return "(long)REG_INT($regnum)";
};
/4/ && do {my $regnum = $reg_ref->{i}++;
- return "(long*)&INT_REG($regnum)";
+ return "(long*)®_INT($regnum)";
};
/s/ && do {my $regnum = $reg_ref->{i}++;
- return "(short)INT_REG($regnum)";
+ return "(short)REG_INT($regnum)";
};
/c/ && do {my $regnum = $reg_ref->{i}++;
- return "(char)INT_REG($regnum)";
+ return "(char)REG_INT($regnum)";
};
/2/ && do {my $regnum = $reg_ref->{i}++;
- return "(short*)&INT_REG($regnum)";
+ return "(short*)®_INT($regnum)";
};
/f/ && do {my $regnum = $reg_ref->{n}++;
- return "(float)NUM_REG($regnum)";
+ return "(float)REG_NUM($regnum)";
};
/d/ && do {my $regnum = $reg_ref->{n}++;
- return "(double)NUM_REG($regnum)";
+ return "(double)REG_NUM($regnum)";
};
/t/ && do {my $regnum = $reg_ref->{s}++;
- return "string_to_cstring(interpreter, STR_REG($regnum))";
+ return "string_to_cstring(interpreter, REG_STR($regnum))";
};
/b/ && do {my $regnum = $reg_ref->{s}++;
- return "STR_REG($regnum)->bufstart";
+ return "REG_STR($regnum)->bufstart";
};
/B/ && do {my $regnum = $reg_ref->{s}++;
- return "&(STR_REG($regnum)->bufstart)";
+ return "&(REG_STR($regnum)->bufstart)";
};
/I/ && do {
return "interpreter";
};
/P/ && do {my $regnum = $reg_ref->{p}++;
- return "PMC_REG($regnum)";
+ return "REG_PMC($regnum) == PMCNULL ? NULL : REG_PMC($regnum)";
};
}
@@ -354,11 +345,11 @@
pointer = self->cache.struct_val;
return_data = ($ret_type)(*pointer)($params);
$ret_reg = return_data;
- INT_REG(0) = $stack_returns;
- INT_REG(1) = $int_returns;
- INT_REG(2) = $string_returns;
- INT_REG(3) = $pmc_returns;
- INT_REG(4) = $num_returns;
+ REG_INT(0) = $stack_returns;
+ REG_INT(1) = $int_returns;
+ REG_INT(2) = $string_returns;
+ REG_INT(3) = $pmc_returns;
+ REG_INT(4) = $num_returns;
return;
}
EOR
1.163 +1 -1 parrot/config/gen/makefiles/root.in
Index: root.in
===================================================================
RCS file: /cvs/public/parrot/config/gen/makefiles/root.in,v
retrieving revision 1.162
retrieving revision 1.163
diff -u -w -r1.162 -r1.163
--- root.in 29 Oct 2003 07:33:21 -0000 1.162
+++ root.in 29 Oct 2003 09:18:21 -0000 1.163
@@ -855,7 +855,7 @@
###### OS depend targets ##########
# libnci.so used by t/pmc/nci.t
-src/libnci$(O): $(SRC)/nci_test.c
+$(SRC)/libnci$(O): $(SRC)/nci_test.c
libnci$(SO): $(SRC)/nci_test$(O) parrot${exe}
$(LD) $(LD_SHARED) $(LD_SHARED_FLAGS) $(LDFLAGS) \
1.50 +4 -0 parrot/lib/Parrot/Test.pm
Index: Test.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Test.pm,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -w -r1.49 -r1.50
--- Test.pm 27 Oct 2003 15:36:50 -0000 1.49
+++ Test.pm 29 Oct 2003 09:18:23 -0000 1.50
@@ -145,6 +145,10 @@
my $run_pbc = 0;
if ($args =~ s/--run-pbc//) {
+ # native tests with --run-pbc don't make sense
+ if ($as_f =~ /native_pbc/) {
+ return $Builder->ok(1, $desc);
+ }
my $pbc_f = per_test('.pbc', $count);
$run_pbc = 1;
$args = "$args -o $pbc_f -r -r";
1.3 +1 -0 parrot/libnci.def
Index: libnci.def
===================================================================
RCS file: /cvs/public/parrot/libnci.def,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- libnci.def 29 Oct 2003 07:33:24 -0000 1.2
+++ libnci.def 29 Oct 2003 09:18:25 -0000 1.3
@@ -16,3 +16,4 @@
nci_i4i
nci_ii3
nci_pi
+ nci_vP
1.18 +2 -0 parrot/src/call_list.txt
Index: call_list.txt
===================================================================
RCS file: /cvs/public/parrot/src/call_list.txt,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- call_list.txt 23 Oct 2003 17:58:31 -0000 1.17
+++ call_list.txt 29 Oct 2003 09:18:27 -0000 1.18
@@ -18,6 +18,7 @@
# p - data pointer from PMC (on store into a new UnManagedStruct PMC)
# P - pointer to a PMC-register
# special stuff
+# 0 - insert a NULL (pointer) - doesn't comsume a register
# I - Parrot_Interp param
#
#Return params
@@ -148,3 +149,4 @@
i i3
t b
t B
+v P
1.12 +9 -0 parrot/src/nci_test.c
Index: nci_test.c
===================================================================
RCS file: /cvs/public/parrot/src/nci_test.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- nci_test.c 29 Oct 2003 07:33:26 -0000 1.11
+++ nci_test.c 29 Oct 2003 09:18:27 -0000 1.12
@@ -19,6 +19,7 @@
int nci_i4i(long * l, int i);
int nci_ii3(int a, int *b);
void * nci_pi(int test);
+void nci_vP(void *pmc);
double nci_dd(double d) {
return d * 2.0;
@@ -117,6 +118,14 @@
}
}
return NULL;
+}
+
+void nci_vP(void *pmc)
+{
+ if (pmc)
+ puts("ok");
+ else
+ puts("got null");
}
#ifdef TEST
1.19 +15 -1 parrot/t/pmc/nci.t
Index: nci.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/nci.t,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -w -r1.18 -r1.19
--- nci.t 4 Oct 2003 11:57:16 -0000 1.18
+++ nci.t 29 Oct 2003 09:18:31 -0000 1.19
@@ -1,4 +1,4 @@
-use Parrot::Test tests => 16;
+use Parrot::Test tests => 17;
use Parrot::Config;
print STDERR $PConfig{jitcpuarch}, " JIT CPU\n";
@@ -439,6 +439,20 @@
42.000000
100.000000
47.110000
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "nci_v_P");
+ loadlib P1, "libnci"
+ dlfunc P0, P1, "nci_vP", "vP"
+ new P5, .PerlString
+ set P5, "ok\n"
+ invoke
+ null P5
+ invoke
+ end
+CODE
+ok
+got null
OUTPUT
} # SKIP
