cvsuser 04/12/09 08:12:55
Modified: classes perlundef.pmc
include/parrot mmd.h
src mmd.c pmc.c
t/pmc mmd.t pmc.t
Log:
fix PerlUndef.logical_xor
Revision Changes Path
1.43 +12 -2 parrot/classes/perlundef.pmc
Index: perlundef.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlundef.pmc,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -r1.42 -r1.43
--- perlundef.pmc 17 Jul 2004 16:01:05 -0000 1.42
+++ perlundef.pmc 9 Dec 2004 16:12:43 -0000 1.43
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlundef.pmc,v 1.42 2004/07/17 16:01:05 leo Exp $
+$Id: perlundef.pmc,v 1.43 2004/12/09 16:12:43 leo Exp $
=head1 NAME
@@ -606,7 +606,17 @@
*/
void logical_xor (PMC* value, PMC* dest) {
- VTABLE_set_pmc(INTERP, dest, value);
+MMD_PerlUndef: {
+ VTABLE_set_integer_native(interpreter, dest, 0);
+ }
+MMD_DEFAULT: {
+
+ INTVAL value_bool = VTABLE_get_bool(interpreter, value);
+ if (value_bool)
+ VTABLE_set_pmc(INTERP, dest, value);
+ else
+ VTABLE_set_integer_native(interpreter, dest, 0);
+ }
}
/*
1.23 +4 -1 parrot/include/parrot/mmd.h
Index: mmd.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/mmd.h,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- mmd.h 7 Dec 2004 17:24:52 -0000 1.22
+++ mmd.h 9 Dec 2004 16:12:46 -0000 1.23
@@ -1,7 +1,7 @@
/* mmd.h
* Copyright: 2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: mmd.h,v 1.22 2004/12/07 17:24:52 rubys Exp $
+ * $Id: mmd.h,v 1.23 2004/12/09 16:12:46 leo Exp $
* Overview:
* This is the api header for the mmd subsystem
* Data Structure and Algorithms:
@@ -27,6 +27,9 @@
void mmd_destroy(Parrot_Interp);
PMC *mmd_vtfind(Parrot_Interp, INTVAL, INTVAL, INTVAL);
+funcptr_t get_mmd_dispatch_type(Interp *interpreter,
+ INTVAL function, UINTVAL left_type, UINTVAL right_type, int *is_pmc);
+
typedef struct _MMD_table {
funcptr_t *mmd_funcs; /* The functions for the MMD table */
UINTVAL x; /* The x coord for each table */
1.47 +10 -13 parrot/src/mmd.c
Index: mmd.c
===================================================================
RCS file: /cvs/public/parrot/src/mmd.c,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -r1.46 -r1.47
--- mmd.c 9 Dec 2004 13:31:05 -0000 1.46
+++ mmd.c 9 Dec 2004 16:12:48 -0000 1.47
@@ -1,6 +1,6 @@
/*
Copyright: 2003 The Perl Foundation. All Rights Reserved.
-$Id: mmd.c,v 1.46 2004/12/09 13:31:05 leo Exp $
+$Id: mmd.c,v 1.47 2004/12/09 16:12:48 leo Exp $
=head1 NAME
@@ -96,13 +96,10 @@
}
#endif
-funcptr_t
-get_mmd_dispatch_type(Interp *interpreter, UINTVAL left_type,
- UINTVAL right_type, INTVAL function, int *is_pmc);
funcptr_t
-get_mmd_dispatch_type(Interp *interpreter, UINTVAL left_type,
- UINTVAL right_type, INTVAL function, int *is_pmc)
+get_mmd_dispatch_type(Interp *interpreter, INTVAL function, UINTVAL
left_type,
+ UINTVAL right_type, int *is_pmc)
{
funcptr_t func;
UINTVAL offset, x_funcs, y_funcs;
@@ -170,8 +167,8 @@
UINTVAL left_type, right_type;
left_type = left->vtable->base_type;
right_type = right->vtable->base_type;
- return get_mmd_dispatch_type(interpreter, left_type, right_type,
- function, is_pmc);
+ return get_mmd_dispatch_type(interpreter, function, left_type,
right_type,
+ is_pmc);
}
/*
@@ -245,7 +242,7 @@
left_type = left->vtable->base_type;
real_function = (mmd_f_v_pip)get_mmd_dispatch_type(interpreter,
- left_type, 0, function, &is_pmc);
+ function, left_type, 0, &is_pmc);
if (is_pmc) {
sub = (PMC*)real_function;
Parrot_runops_fromc_args(interpreter, sub, "vPIP",
@@ -267,7 +264,7 @@
left_type = left->vtable->base_type;
real_function = (mmd_f_v_pnp)get_mmd_dispatch_type(interpreter,
- left_type, 0, function, &is_pmc);
+ function, left_type, 0, &is_pmc);
if (is_pmc) {
sub = (PMC*)real_function;
Parrot_runops_fromc_args(interpreter, sub, "vPNP",
@@ -289,7 +286,7 @@
left_type = left->vtable->base_type;
real_function = (mmd_f_v_psp)get_mmd_dispatch_type(interpreter,
- left_type, 0, function, &is_pmc);
+ function, left_type, 0, &is_pmc);
if (is_pmc) {
sub = (PMC*)real_function;
Parrot_runops_fromc_args(interpreter, sub, "vPSP",
@@ -640,11 +637,11 @@
*/
PMC *
-mmd_vtfind(Parrot_Interp interpreter, INTVAL type, INTVAL left, INTVAL
right) {
+mmd_vtfind(Parrot_Interp interpreter, INTVAL function, INTVAL left, INTVAL
right) {
int is_pmc;
PMC *f;
funcptr_t func = get_mmd_dispatch_type(interpreter,
- left, right, type, &is_pmc);
+ function, left, right, &is_pmc);
if (func && is_pmc)
return (PMC*)F2DPTR(func);
f = pmc_new(interpreter, enum_class_CSub);
1.91 +2 -5 parrot/src/pmc.c
Index: pmc.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc.c,v
retrieving revision 1.90
retrieving revision 1.91
diff -u -r1.90 -r1.91
--- pmc.c 9 Dec 2004 13:31:05 -0000 1.90
+++ pmc.c 9 Dec 2004 16:12:48 -0000 1.91
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: pmc.c,v 1.90 2004/12/09 13:31:05 leo Exp $
+$Id: pmc.c,v 1.91 2004/12/09 16:12:48 leo Exp $
=head1 NAME
@@ -418,9 +418,6 @@
*/
-funcptr_t
-get_mmd_dispatch_type(Interp *interpreter, UINTVAL left_type,
- UINTVAL right_type, INTVAL function, int *is_pmc);
void
Parrot_mmd_register_parents(Interp* interpreter, INTVAL type,
@@ -508,7 +505,7 @@
continue;
if (j >= enum_class_core_max || j <= enum_class_Boolean)
{
f = get_mmd_dispatch_type(interpreter,
- parent_type, j, func_nr, &is_pmc);
+ func_nr, parent_type, j, &is_pmc);
if (f != table->default_func) {
mmd_register(interpreter,
func_nr, type, j, f);
1.13 +3 -3 parrot/t/pmc/mmd.t
Index: mmd.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/mmd.t,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- mmd.t 9 Dec 2004 13:31:06 -0000 1.12
+++ mmd.t 9 Dec 2004 16:12:54 -0000 1.13
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: mmd.t,v 1.12 2004/12/09 13:31:06 leo Exp $
+# $Id: mmd.t,v 1.13 2004/12/09 16:12:54 leo Exp $
=head1 NAME
@@ -46,11 +46,11 @@
.param pmc lhs
$I0 = left
$I1 = right
- $I2 = $I0*$I1 # don't call divide Integer/PerlInt here
+ $I2 = $I0/$I1 # don't call divide Integer/PerlInt here
lhs = $I2 # '
.end
CODE
-30
+3
OUTPUT
output_is(<<'CODE', <<'OUTPUT', "1+1=3");
1.99 +3 -3 parrot/t/pmc/pmc.t
Index: pmc.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/pmc.t,v
retrieving revision 1.98
retrieving revision 1.99
diff -u -r1.98 -r1.99
--- pmc.t 7 Dec 2004 10:50:41 -0000 1.98
+++ pmc.t 9 Dec 2004 16:12:54 -0000 1.99
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: pmc.t,v 1.98 2004/12/07 10:50:41 leo Exp $
+# $Id: pmc.t,v 1.99 2004/12/09 16:12:54 leo Exp $
=head1 NAME
@@ -1021,7 +1021,7 @@
print P0
print "b"
-#undef xor undef = 0
+#undef xor undef = "0"
xor P0, P1, P1
print P0
print "c"
@@ -1051,7 +1051,7 @@
print "\\n"
end
CODE
-abc349c910xy1z
+ab0c349c910xy1z
OUTPUT
output_is(<<"CODE", <<'OUTPUT', "undef-add");
