cvsuser 04/11/25 06:01:55
Modified: imcc parser_util.c
lib/Parrot Op.pm
ops math.ops ops.num
t/op gc.t
Log:
deprecate transcendental ops with INT args
Revision Changes Path
1.86 +48 -18 parrot/imcc/parser_util.c
Index: parser_util.c
===================================================================
RCS file: /cvs/public/parrot/imcc/parser_util.c,v
retrieving revision 1.85
retrieving revision 1.86
diff -u -r1.85 -r1.86
--- parser_util.c 23 Nov 2004 08:32:03 -0000 1.85
+++ parser_util.c 25 Nov 2004 14:01:31 -0000 1.86
@@ -598,6 +598,37 @@
/* Parrot_compreg(interp, const_string(interp, "FILE"),
imcc_compile_file ); */
}
+static int
+change_op(Interp *interpreter, IMC_Unit *unit, SymReg **r, int num, int emit)
+{
+ int changed = 0;
+ SymReg *s;
+
+ if (r[num]->type & VTCONST) {
+ /* make a number const */
+ s = mk_const(str_dup(r[num]->name), 'N');
+ r[num] = s;
+ changed = 1;
+ }
+ else if (emit) {
+ /* emit
+ * set $N0, Iy
+ * op Nx, $N0
+ * or
+ * op Nx, ..., $N0
+ */
+ SymReg *rr[IMCC_MAX_REGS];
+
+ rr[0] = mk_temp_reg('N');
+ rr[1] = r[num];
+ INS(interpreter, unit, "set", NULL, rr, 2, 0, 1);
+ r[num] = rr[0];
+ changed = 1;
+ /* need to allocate the temp - run reg_alloc */
+ optimizer_level |= OPT_PASM;
+ }
+ return changed;
+}
/*
* Try to find valid op doing the same operation
@@ -606,6 +637,7 @@
* div_n_ic_n => div_n_nc_n
* div_n_i_n => set_n_i ; div_n_n_n
* ge_n_ic_ic => ge_n_nc_ic
+ * acos_n_i => acos_n_n
*/
int
try_find_op(Parrot_Interp interpreter, IMC_Unit * unit, char *name,
@@ -652,14 +684,20 @@
}
else if (n == 3 &&
(!strcmp(name, "cmp_str") ||
- !strcmp(name, "cmp_num"))) {
+ !strcmp(name, "cmp_num"))) {
name = "cmp";
changed = 1;
}
/*
* TODO handle eq_i_n_ic too
*/
- if (n == 3 && r[0]->set == 'N') {
+ if (n == 3 && !strcmp(name, "atan")) {
+ if (r[1]->set == 'I')
+ changed |= change_op(interpreter, unit, r, 1, emit);
+ if (r[2]->set == 'I')
+ changed |= change_op(interpreter, unit, r, 2, emit);
+ }
+ else if (n == 3 && r[0]->set == 'N') {
if (r[1]->set == 'I' && (r[2]->set == 'N' ||
(r[2]->type == VTADDRESS))) {
if (!strcmp(name, "add") ||
@@ -672,24 +710,16 @@
r[2] = s;
changed = 1;
}
- else if (r[1]->type & VTCONST) {
- /* make a number const */
- s = mk_const(str_dup(r[1]->name), 'N');
- r[1] = s;
- changed = 1;
- }
- else if (emit) {
- /* emit set_n_ix */
- SymReg *rr[IMCC_MAX_REGS];
-
- rr[0] = mk_temp_reg('N');
- rr[1] = r[1];
- INS(interpreter, unit, "set", NULL, rr, 2, 0, 1);
- r[1] = rr[0];
- changed = 1;
- }
+ else
+ changed = change_op(interpreter, unit, r, 1, emit);
}
}
+ else if (n == 2 && r[0]->set == 'N' && r[1]->set == 'I') {
+ /*
+ * transcendentals e.g. acos N, I
+ */
+ changed = change_op(interpreter, unit, r, 1, emit);
+ }
if (changed) {
op_fullname(fullname, name, r, n, keyvec);
return interpreter->op_lib->op_code(fullname, 1);
1.17 +15 -13 parrot/lib/Parrot/Op.pm
Index: Op.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Op.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- Op.pm 4 Apr 2004 23:44:36 -0000 1.16
+++ Op.pm 25 Nov 2004 14:01:42 -0000 1.17
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-# $Id: Op.pm,v 1.16 2004/04/04 23:44:36 mikescott Exp $
+# $Id: Op.pm,v 1.17 2004/11/25 14:01:42 leo Exp $
=head1 NAME
@@ -25,7 +25,7 @@
Note that F<build_tools/ops2c.pl> supplies either 'inline' or 'function'
as the op's type, depending on whether the C<inline> keyword is present
-in the op definition. This has the effect of causing all ops to be
+in the op definition. This has the effect of causing all ops to be
considered manual.
=head2 Op Arguments
@@ -77,7 +77,7 @@
C<$name> is the name of the op.
-C<$args> is a reference to an array of argument type descriptors.
+C<$args> is a reference to an array of argument type descriptors.
C<$argdirs> is a reference to an array of argument direction
descriptors. Element I<x> is the direction of argument C<< $args->[I<x>]
@@ -95,7 +95,7 @@
my $class = shift;
my ($code, $type, $name, $args, $argdirs, $labels, $flags) = @_;
- my $self = {
+ my $self = {
CODE => $code,
TYPE => $type,
NAME => $name,
@@ -173,6 +173,8 @@
$name .= "_" . join("_", @arg_types) if @arg_types;
+ $name = "deprecated_$name" if ($self->body =~ /DEPRECATED/);
+
return $name;
}
@@ -253,7 +255,7 @@
{
my $self = shift;
- if (@_)
+ if (@_)
{
$self->{FLAGS} = shift;
}
@@ -286,7 +288,7 @@
{
my $self = shift;
- if (@_)
+ if (@_)
{
$self->{BODY} = shift;
}
@@ -308,7 +310,7 @@
{
my $self = shift;
- if (@_)
+ if (@_)
{
$self->{JUMP} = shift;
}
@@ -335,7 +337,7 @@
}
# Called from rewrite_body() to perform the actual substitutions.
-sub _substitute
+sub _substitute
{
my $self = shift;
local $_ = shift;
@@ -373,7 +375,7 @@
=cut
-sub rewrite_body
+sub rewrite_body
{
my ($self, $body, $trans) = @_;
@@ -386,12 +388,12 @@
)->vtable->\s*(\w+)\(
!VTABLE_$1(!sgx;
- while (1)
+ while (1)
{
my $new_body = $self->_substitute($body, $trans);
-
+
last if $body eq $new_body;
-
+
$body = $new_body;
}
@@ -467,4 +469,4 @@
=end TODO
-=cut
\ No newline at end of file
+=cut
1.28 +27 -21 parrot/ops/math.ops
Index: math.ops
===================================================================
RCS file: /cvs/public/parrot/ops/math.ops,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -r1.27 -r1.28
--- math.ops 5 Oct 2004 16:22:39 -0000 1.27
+++ math.ops 25 Nov 2004 14:01:48 -0000 1.28
@@ -2,6 +2,9 @@
** math.ops
*/
+#define DEPRECATED internal_exception(UNIMPLEMENTED, "you should't see this")
+
+
VERSION = PARROT_VERSION;
=head1 NAME
@@ -980,10 +983,14 @@
Set $1 to the square root of $2.
+Please note that for all these opcodes the variant with an INTVAL
+argument is deprecated. Actually code is generated that uses a
+FLOATVAL argument instead.
+
=cut
inline op sqrt(out NUM, in INT) :base_core {
- $1 = sqrt((FLOATVAL)$2);
+ DEPRECATED;
goto NEXT();
}
@@ -1020,7 +1027,7 @@
=cut
inline op acos(out NUM, in INT) :base_math {
- $1 = acos((FLOATVAL)$2);
+ DEPRECATED;
goto NEXT();
}
@@ -1040,7 +1047,7 @@
=cut
inline op asec(out NUM, in INT) :base_math {
- $1 = acos(((FLOATVAL)1) / ((FLOATVAL)$2));
+ DEPRECATED;
goto NEXT();
}
@@ -1060,7 +1067,7 @@
=cut
inline op asin(out NUM, in INT) :base_math {
- $1 = asin((FLOATVAL)$2);
+ DEPRECATED;
goto NEXT();
}
@@ -1092,7 +1099,7 @@
=cut
inline op atan(out NUM, in INT) :base_math {
- $1 = atan((FLOATVAL)$2);
+ DEPRECATED;
goto NEXT();
}
@@ -1102,17 +1109,17 @@
}
inline op atan(out NUM, in INT, in INT) :base_math {
- $1 = atan2((FLOATVAL)$2, (FLOATVAL)$3);
+ DEPRECATED;
goto NEXT();
}
inline op atan(out NUM, in INT, in NUM) :base_math {
- $1 = atan2((FLOATVAL)$2, (FLOATVAL)$3);
+ DEPRECATED;
goto NEXT();
}
inline op atan(out NUM, in NUM, in INT) :base_math {
- $1 = atan2((FLOATVAL)$2, (FLOATVAL)$3);
+ DEPRECATED;
goto NEXT();
}
@@ -1132,7 +1139,7 @@
=cut
inline op cos(out NUM, in INT) :base_math {
- $1 = cos((FLOATVAL)$2);
+ DEPRECATED;
goto NEXT();
}
@@ -1152,7 +1159,7 @@
=cut
inline op cosh(out NUM, in INT) :base_math {
- $1 = cosh((FLOATVAL)$2);
+ DEPRECATED;
goto NEXT();
}
@@ -1172,7 +1179,7 @@
=cut
inline op exp(out NUM, in INT) :base_math {
- $1 = exp((FLOATVAL)$2);
+ DEPRECATED;
goto NEXT();
}
@@ -1192,7 +1199,7 @@
=cut
inline op ln(out NUM, in INT) :base_math {
- $1 = log((FLOATVAL)$2);
+ DEPRECATED;
goto NEXT();
}
@@ -1212,7 +1219,7 @@
=cut
inline op log10(out NUM, in INT) :base_math {
- $1 = log10((FLOATVAL)$2);
+ DEPRECATED;
goto NEXT();
}
@@ -1232,8 +1239,7 @@
=cut
op log2(out NUM, in INT) :base_math {
- FLOATVAL temp = log((FLOATVAL)2.0);
- $1 = log((FLOATVAL)$2) / temp;
+ DEPRECATED;
goto NEXT();
}
@@ -1254,7 +1260,7 @@
=cut
inline op sec(out NUM, in INT) :base_math {
- $1 = ((FLOATVAL)1) / cos((FLOATVAL)$2);
+ DEPRECATED;
goto NEXT();
}
@@ -1274,7 +1280,7 @@
=cut
inline op sech(out NUM, in INT) :base_math {
- $1 = ((FLOATVAL)1) / cosh((FLOATVAL)$2);
+ DEPRECATED;
goto NEXT();
}
@@ -1294,7 +1300,7 @@
=cut
inline op sin(out NUM, in INT) :base_math {
- $1 = sin((FLOATVAL)$2);
+ DEPRECATED;
goto NEXT();
}
@@ -1314,7 +1320,7 @@
=cut
inline op sinh(out NUM, in INT) :base_math {
- $1 = sinh((FLOATVAL)$2);
+ DEPRECATED;
goto NEXT();
}
@@ -1334,7 +1340,7 @@
=cut
inline op tan(out NUM, in INT) :base_math {
- $1 = tan((FLOATVAL)$2);
+ DEPRECATED;
goto NEXT();
}
@@ -1354,7 +1360,7 @@
=cut
inline op tanh(out NUM, in INT) :base_math {
- $1 = tanh((FLOATVAL)$2);
+ DEPRECATED;
goto NEXT();
}
1.46 +46 -46 parrot/ops/ops.num
Index: ops.num
===================================================================
RCS file: /cvs/public/parrot/ops/ops.num,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -r1.45 -r1.46
--- ops.num 23 Nov 2004 11:06:11 -0000 1.45
+++ ops.num 25 Nov 2004 14:01:48 -0000 1.46
@@ -647,84 +647,84 @@
sub_p_p_n 620
sub_p_p_nc 621
sub_p_p_p 622
-acos_n_i 623
-acos_n_ic 624
+deprecated_acos_n_i 623
+deprecated_acos_n_ic 624
acos_n_n 625
acos_n_nc 626
-asec_n_i 627
-asec_n_ic 628
+deprecated_asec_n_i 627
+deprecated_asec_n_ic 628
asec_n_n 629
asec_n_nc 630
-asin_n_i 631
-asin_n_ic 632
+deprecated_asin_n_i 631
+deprecated_asin_n_ic 632
asin_n_n 633
asin_n_nc 634
-atan_n_i 635
-atan_n_ic 636
+deprecated_atan_n_i 635
+deprecated_atan_n_ic 636
atan_n_n 637
atan_n_nc 638
-atan_n_i_i 639
-atan_n_ic_i 640
-atan_n_i_ic 641
-atan_n_ic_ic 642
-atan_n_i_n 643
-atan_n_ic_n 644
-atan_n_i_nc 645
-atan_n_ic_nc 646
-atan_n_n_i 647
-atan_n_nc_i 648
-atan_n_n_ic 649
-atan_n_nc_ic 650
+deprecated_atan_n_i_i 639
+deprecated_atan_n_ic_i 640
+deprecated_atan_n_i_ic 641
+deprecated_atan_n_ic_ic 642
+deprecated_atan_n_i_n 643
+deprecated_atan_n_ic_n 644
+deprecated_atan_n_i_nc 645
+deprecated_atan_n_ic_nc 646
+deprecated_atan_n_n_i 647
+deprecated_atan_n_nc_i 648
+deprecated_atan_n_n_ic 649
+deprecated_atan_n_nc_ic 650
atan_n_n_n 651
atan_n_nc_n 652
atan_n_n_nc 653
atan_n_nc_nc 654
-cos_n_i 655
-cos_n_ic 656
+deprecated_cos_n_i 655
+deprecated_cos_n_ic 656
cos_n_n 657
cos_n_nc 658
-cosh_n_i 659
-cosh_n_ic 660
+deprecated_cosh_n_i 659
+deprecated_cosh_n_ic 660
cosh_n_n 661
cosh_n_nc 662
-exp_n_i 663
-exp_n_ic 664
+deprecated_exp_n_i 663
+deprecated_exp_n_ic 664
exp_n_n 665
exp_n_nc 666
-ln_n_i 667
-ln_n_ic 668
+deprecated_ln_n_i 667
+deprecated_ln_n_ic 668
ln_n_n 669
ln_n_nc 670
-log10_n_i 671
-log10_n_ic 672
+deprecated_log10_n_i 671
+deprecated_log10_n_ic 672
log10_n_n 673
log10_n_nc 674
-log2_n_i 675
-log2_n_ic 676
+deprecated_log2_n_i 675
+deprecated_log2_n_ic 676
log2_n_n 677
log2_n_nc 678
-sec_n_i 679
-sec_n_ic 680
+deprecated_sec_n_i 679
+deprecated_sec_n_ic 680
sec_n_n 681
sec_n_nc 682
-sech_n_i 683
-sech_n_ic 684
+deprecated_sech_n_i 683
+deprecated_sech_n_ic 684
sech_n_n 685
sech_n_nc 686
-sin_n_i 687
-sin_n_ic 688
+deprecated_sin_n_i 687
+deprecated_sin_n_ic 688
sin_n_n 689
sin_n_nc 690
-sinh_n_i 691
-sinh_n_ic 692
+deprecated_sinh_n_i 691
+deprecated_sinh_n_ic 692
sinh_n_n 693
sinh_n_nc 694
-tan_n_i 695
-tan_n_ic 696
+deprecated_tan_n_i 695
+deprecated_tan_n_ic 696
tan_n_n 697
tan_n_nc 698
-tanh_n_i 699
-tanh_n_ic 700
+deprecated_tanh_n_i 699
+deprecated_tanh_n_ic 700
tanh_n_n 701
tanh_n_nc 702
gcd_i_i_i 703
@@ -1407,8 +1407,8 @@
fetchmethod_p_p_s 1380
fetchmethod_p_p_sc 1381
setref_p_p 1382
-sqrt_n_i 1383
-sqrt_n_ic 1384
+deprecated_sqrt_n_i 1383
+deprecated_sqrt_n_ic 1384
sqrt_n_n 1385
sqrt_n_nc 1386
gcd_i_i_i_i_i 1387
1.25 +6 -7 parrot/t/op/gc.t
Index: gc.t
===================================================================
RCS file: /cvs/public/parrot/t/op/gc.t,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- gc.t 19 Nov 2004 13:45:30 -0000 1.24
+++ gc.t 25 Nov 2004 14:01:55 -0000 1.25
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: gc.t,v 1.24 2004/11/19 13:45:30 leo Exp $
+# $Id: gc.t,v 1.25 2004/11/25 14:01:55 leo Exp $
=head1 NAME
@@ -473,17 +473,16 @@
.sub b11 method
.param pmc n
.local pmc n1
- new_pad -1
- store_lex -1, "n", n
+ # new_pad -1
+ # store_lex -1, "n", n
n1 = new Integer
n1 = n + 1
- newsub $P0, .Exception_Handler, catch
- set_eh $P0
+ push_eh catch
n = self."b11"(n1)
- store_lex -1, "n", n
+ # store_lex -1, "n", n
clear_eh
catch:
- n = find_lex "n"
+ # n = find_lex "n"
.return(n)
.end
CODE
