cvsuser 03/09/11 04:19:25
Modified: classes perlint.pmc
languages/imcc optimizer.c
. math.ops
t/pmc perlint.t
Log:
PerlInt math: divide gives int if possible
add documented but missing div_p_p op
Revision Changes Path
1.43 +95 -66 parrot/classes/perlint.pmc
Index: perlint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlint.pmc,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -w -r1.42 -r1.43
--- perlint.pmc 9 Sep 2003 10:25:35 -0000 1.42
+++ perlint.pmc 11 Sep 2003 11:19:21 -0000 1.43
@@ -1,7 +1,7 @@
/* perlint.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: perlint.pmc,v 1.42 2003/09/09 10:25:35 leo Exp $
+ * $Id: perlint.pmc,v 1.43 2003/09/11 11:19:21 leo Exp $
* Overview:
* These are the vtable functions for the PerlInt base class
* Data Structure and Algorithms:
@@ -69,9 +69,6 @@
DYNSELF.set_string_native(value);
}
- /* XXX -lt: only add done yet, others will follow, when
- * vtable changes are carved in electrons
- */
void add (PMC* value, PMC* dest) {
INTVAL pmci;
int vtype = VTABLE_type(INTERP, value);
@@ -109,26 +106,35 @@
}
void subtract (PMC* value, PMC* dest) {
- int type = enum_class_PerlInt;
- INTVAL i;
+ INTVAL pmci;
+ int vtype = VTABLE_type(INTERP, value);
+ FLOATVAL valf;
+ FLOATVAL diff;
+
+ pmci = SELF->cache.int_val;
+ if (vtype == enum_class_PerlUndef) {
+ VTABLE_set_integer_native(INTERP, dest, pmci);
+ return;
+ }
+
+ valf = VTABLE_get_number(INTERP, value);
+ diff = pmci - valf;
+ if (vtype == enum_class_PerlNum) {
+ VTABLE_set_number_native(INTERP, dest, diff);
+ return;
+ }
+ {
+ INTVAL vali = (INTVAL) valf;
+ INTVAL difi = pmci - vali;
+ if (diff == difi)
+ VTABLE_set_integer_native(INTERP, dest, difi);
+ else {
+ /* TODO BIG* promotion */
+ VTABLE_set_number_native(INTERP, dest, diff);
+ }
+ return;
- if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- type = enum_class_PerlNum;
}
- else if(value->vtable == &Parrot_base_vtables[enum_class_PerlString]) {
- FLOATVAL f = VTABLE_get_number(INTERP, value);
- i = VTABLE_get_integer(INTERP, value);
- if(f != i) {
- type = enum_class_PerlNum;
- }
- }
- i = SELF->cache.int_val;
- if(type == enum_class_PerlNum)
- VTABLE_set_number_native(INTERP, dest,
- i - VTABLE_get_number(INTERP, value));
- else
- VTABLE_set_integer_native(INTERP, dest,
- i - VTABLE_get_integer(INTERP, value));
}
void subtract_int (INTVAL value, PMC* dest) {
@@ -142,26 +148,35 @@
}
void multiply (PMC* value, PMC* dest) {
- int type = enum_class_PerlInt;
- INTVAL i;
+ INTVAL pmci;
+ int vtype = VTABLE_type(INTERP, value);
+ FLOATVAL valf;
+ FLOATVAL mulf;
+
+ pmci = SELF->cache.int_val;
+ if (vtype == enum_class_PerlUndef) {
+ VTABLE_set_integer_native(INTERP, dest, pmci);
+ return;
+ }
+
+ valf = VTABLE_get_number(INTERP, value);
+ mulf = pmci * valf;
+ if (vtype == enum_class_PerlNum) {
+ VTABLE_set_number_native(INTERP, dest, mulf);
+ return;
+ }
+ {
+ INTVAL vali = (INTVAL) valf;
+ INTVAL muli = pmci * vali;
+ if (mulf == muli)
+ VTABLE_set_integer_native(INTERP, dest, muli);
+ else {
+ /* TODO BIG* promotion */
+ VTABLE_set_number_native(INTERP, dest, mulf);
+ }
+ return;
- if(value->vtable == &Parrot_base_vtables[enum_class_PerlNum]) {
- type = enum_class_PerlNum;
}
- else if(value->vtable == &Parrot_base_vtables[enum_class_PerlString]) {
- FLOATVAL f = VTABLE_get_number(INTERP, value);
- i = VTABLE_get_integer(INTERP, value);
- if(f != i) {
- type = enum_class_PerlNum;
- }
- }
- i = SELF->cache.int_val;
- if(type == enum_class_PerlNum)
- VTABLE_set_number_native(INTERP, dest,
- i * VTABLE_get_number(INTERP, value));
- else
- VTABLE_set_integer_native(INTERP, dest,
- i * VTABLE_get_integer(INTERP, value));
}
void multiply_int (INTVAL value, PMC* dest) {
@@ -175,45 +190,59 @@
}
void divide (PMC* value, PMC* dest) {
- VTABLE_set_number_native(INTERP, dest,
- SELF->cache.int_val / VTABLE_get_number(INTERP, value));
+ INTVAL pmci;
+ int vtype = VTABLE_type(INTERP, value);
+ FLOATVAL valf;
+ FLOATVAL divf;
+
+ pmci = SELF->cache.int_val;
+ if (vtype == enum_class_PerlUndef) {
+ VTABLE_set_integer_native(INTERP, dest, pmci);
+ return;
+ }
+
+ valf = VTABLE_get_number(INTERP, value);
+ divf = pmci / valf;
+ if (vtype == enum_class_PerlNum) {
+ VTABLE_set_number_native(INTERP, dest, divf);
+ return;
+ }
+ {
+ INTVAL vali = (INTVAL) valf;
+ INTVAL divi = pmci / vali;
+ /* if result is an integer or zero yield an integer */
+ if (divf == divi || !pmci)
+ VTABLE_set_integer_native(INTERP, dest, divi);
+ else {
+ /* TODO BIG* promotion */
+ VTABLE_set_number_native(INTERP, dest, divf);
+ }
+ return;
+
+ }
}
void divide_int (INTVAL value, PMC* dest) {
- VTABLE_set_number_native(INTERP, dest,
- (FLOATVAL)SELF->cache.int_val / value
- );
+ INTVAL pmci, divi;
+ FLOATVAL valf, divf;
+
+ pmci = SELF->cache.int_val;
+ /* TODO exception */
+ divf = (FLOATVAL)pmci / value;
+ divi = pmci / value;
+ if (divf == divi || !pmci)
+ VTABLE_set_integer_native(INTERP, dest, divi);
+ else {
+ /* TODO BIG* promotion */
+ VTABLE_set_number_native(INTERP, dest, divf);
+ }
}
void divide_same (PMC* value, PMC* dest) {
- dest->cache.int_val = SELF->cache.int_val / value->cache.int_val;
+ SELF.divide_int(value->cache.int_val, dest);
}
void cmodulus (PMC* value, PMC* dest) {
- INTVAL i;
- FLOATVAL f;
- /*
- * XXX:leo shouldn't that just call get_integer on value
- * and proceed?
- */
- switch(VTABLE_type(INTERP, value)) {
- case enum_class_PerlNum:
- internal_exception(INVALID_OPERATION,
- "modulus() not implemented for mix of INTs and FLOATs\n");
- break;
- case enum_class_PerlString:
- /* Is the string an integer or a number? */
- f = VTABLE_get_number(INTERP, value);
- i = VTABLE_get_integer(INTERP, value);
- if(f != i) {
- internal_exception(INVALID_OPERATION,
- "modulus() not implemented for mix of INTs and FLOATs\n");
- }
- break;
- }
- /* If we're here, then we can assume that get_integer will return
- * something sensible
- */
VTABLE_set_integer_native(INTERP, dest,
SELF->cache.int_val %
VTABLE_get_integer(INTERP, value));
1.38 +1 -1 parrot/languages/imcc/optimizer.c
Index: optimizer.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/optimizer.c,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -w -r1.37 -r1.38
--- optimizer.c 5 Sep 2003 15:31:23 -0000 1.37
+++ optimizer.c 11 Sep 2003 11:19:22 -0000 1.38
@@ -99,7 +99,7 @@
if (optimizer_level & OPT_CFG) {
info(interpreter, 2, "optimize\n");
any = constant_propagation(interpreter);
- if (clone_remove(interpreter))
+ if (0 && clone_remove(interpreter))
return 1;
if (used_once(interpreter))
return 1;
1.10 +5 -0 parrot/math.ops
Index: math.ops
===================================================================
RCS file: /cvs/public/parrot/math.ops,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- math.ops 9 Sep 2003 10:25:29 -0000 1.9
+++ math.ops 11 Sep 2003 11:19:24 -0000 1.10
@@ -366,6 +366,11 @@
goto NEXT();
}
+inline op div (in PMC, in PMC) {
+ $1->vtable->divide(interpreter, $1, $2, $1);
+ goto NEXT();
+}
+
inline op div (in PMC, in INT) {
$1->vtable->divide_int(interpreter, $1, $2, $1);
goto NEXT();
1.8 +24 -2 parrot/t/pmc/perlint.t
Index: perlint.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlint.t,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- perlint.t 7 Aug 2003 14:25:53 -0000 1.7
+++ perlint.t 11 Sep 2003 11:19:25 -0000 1.8
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 10;
+use Parrot::Test tests => 11;
use Parrot::PMC '%pmc_types';
my $perlint = $pmc_types{'PerlInt'};
my $ok = '"ok 1\n"';
@@ -335,5 +335,27 @@
end
CODE
12-1-2
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "divide gives int if possible");
+ new P0, .PerlInt
+ new P1, .PerlInt
+ new P2, .PerlUndef
+ set P0, 12
+ set P1, 2
+ div P2, P0, P1
+ print P2
+ print "\n"
+ div P2, P1
+ print P2
+ print "\n"
+ div P2, 2
+ print P2
+ print "\n"
+ end
+CODE
+6
+3
+1.500000
OUTPUT
