cvsuser 03/09/22 08:01:09
Modified: . MANIFEST bit.ops
languages/imcc/t/syn file.t
t/native_pbc number.t
t/op bitwise.t
t/pmc perlint.t
Added: languages/imcc/t/syn keyed.t
Log:
add missing ops: sh{r,l}; move bogus keyed to imcc tests
Revision Changes Path
1.420 +1 -0 parrot/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.419
retrieving revision 1.420
diff -u -w -r1.419 -r1.420
--- MANIFEST 21 Sep 2003 17:19:01 -0000 1.419
+++ MANIFEST 22 Sep 2003 15:00:56 -0000 1.420
@@ -1526,6 +1526,7 @@
languages/imcc/t/syn/const.t []
languages/imcc/t/syn/eval.t []
languages/imcc/t/syn/file.t []
+languages/imcc/t/syn/keyed.t []
languages/imcc/t/syn/labels.t []
languages/imcc/t/syn/macro.t []
languages/imcc/t/syn/namespace.t []
1.4 +68 -0 parrot/bit.ops
Index: bit.ops
===================================================================
RCS file: /cvs/public/parrot/bit.ops,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- bit.ops 8 Aug 2003 08:44:13 -0000 1.3
+++ bit.ops 22 Sep 2003 15:00:56 -0000 1.4
@@ -236,14 +236,39 @@
}
########################################
+=item B<shl>(inout INT, in INT)
+
+=item B<shl>(in PMC, in INT)
+
+=item B<shl>(in PMC, in PMC)
+
+Shift left $1 by $2 bits.
+
=item B<shl>(out INT, in INT, in INT)
=item B<shl>(in PMC, in PMC, in PMC)
+=item B<shl>(in PMC, in PMC, in INT)
+
Set $1 to the value of $2 shifted left by $3 bits.
=cut
+inline op shl(inout INT, in INT) {
+ $1 <<= $2;
+ goto NEXT();
+}
+
+inline op shl(in PMC, in PMC) {
+ $1->vtable->bitwise_shl(interpreter, $1, $2, $1);
+ goto NEXT();
+}
+
+inline op shl(in PMC, in INT) {
+ $1->vtable->bitwise_shl_int(interpreter, $1, $2, $1);
+ goto NEXT();
+}
+
inline op shl(out INT, in INT, in INT) {
$1 = $2 << $3;
goto NEXT();
@@ -254,16 +279,46 @@
goto NEXT();
}
+inline op shl(in PMC, in PMC, in INT) {
+ $2->vtable->bitwise_shl_int(interpreter, $2, $3, $1);
+ goto NEXT();
+}
+
########################################
+=item B<shr>(inout INT, in INT)
+
+=item B<shr>(in PMC, in INT)
+
+=item B<shr>(in PMC, in PMC)
+
+Shift right $1 by $2 bits.
+
=item B<shr>(out INT, in INT, in INT)
=item B<shr>(in PMC, in PMC, in PMC)
+=item B<shr>(in PMC, in PMC, in INT)
+
Set $1 to the value of $2 shifted right by $3 bits.
=cut
+inline op shr(inout INT, in INT) {
+ $1 >>= $2;
+ goto NEXT();
+}
+
+inline op shr(in PMC, in PMC) {
+ $1->vtable->bitwise_shr(interpreter, $1, $2, $1);
+ goto NEXT();
+}
+
+inline op shr(in PMC, in INT) {
+ $1->vtable->bitwise_shr_int(interpreter, $1, $2, $1);
+ goto NEXT();
+}
+
inline op shr(out INT, in INT, in INT) {
$1 = $2 >> $3;
goto NEXT();
@@ -274,13 +329,26 @@
goto NEXT();
}
+inline op shr(in PMC, in PMC, in INT) {
+ $2->vtable->bitwise_shr_int(interpreter, $2, $3, $1);
+ goto NEXT();
+}
+
########################################
+=item B<lsr>(inout INT, in INT)
+
+Logically shift $1 right by $2.
=item B<lsr>(out INT, in INT, in INT)
Set $1 to the value of $2 logically shifted right by $3 bits.
=cut
+
+inline op lsr(out INT, in INT) {
+ ((UINTVAL)$1) >>= $2;
+ goto NEXT();
+}
inline op lsr(out INT, in INT, in INT) {
$1 = (INTVAL)((UINTVAL)$2 >> $3);
1.10 +4 -0 parrot/languages/imcc/t/syn/file.t
Index: file.t
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/t/syn/file.t,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- file.t 3 Sep 2003 11:42:45 -0000 1.9
+++ file.t 22 Sep 2003 15:00:59 -0000 1.10
@@ -146,6 +146,7 @@
output_is(<<'CODE', <<'OUT', "call sub in external pbc");
.pcc_sub _sub1 prototyped
+ bounds 1 # disable JIT
print "sub1\n"
load_bytecode "temp.pbc"
print "loaded\n"
@@ -180,6 +181,7 @@
output_is(<<'CODE', <<'OUT', "call sub in external pbc, return");
.pcc_sub _sub1 prototyped
print "sub1\n"
+ bounds 1 # disable JIT
load_bytecode "temp.pbc"
print "loaded\n"
$P0 = global "_sub2"
@@ -218,6 +220,7 @@
output_is(<<'CODE', <<'OUT', "call sub in external pbc with 2 subs");
.pcc_sub _sub1 prototyped
print "sub1\n"
+ bounds 1 # disable JIT
load_bytecode "temp.pbc"
print "loaded\n"
$P0 = global "_sub2"
@@ -249,6 +252,7 @@
output_is(<<'CODE', <<'OUT', "call sub in external imc, return");
.pcc_sub _sub1 prototyped
print "sub1\n"
+ bounds 1 # disable JIT
load_bytecode "temp.imc"
print "loaded\n"
$P0 = global "_sub2"
1.1 parrot/languages/imcc/t/syn/keyed.t
Index: keyed.t
===================================================================
#!perl
use strict;
use TestCompiler tests => 1;
##############################
output_is(<<'CODE', <<'OUTPUT', "add_keyed");
.sub _main
new P0, .PerlArray
new P1, .PerlArray
new P2, .PerlArray
set P1[1], 32
set P2[10], 10
add P0[0], P1[1], P2[10]
set P4, P0[0]
print P4
print "\n"
end
.end
CODE
42
OUTPUT
1.9 +1 -1 parrot/t/native_pbc/number.t
Index: number.t
===================================================================
RCS file: /cvs/public/parrot/t/native_pbc/number.t,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- number.t 15 Sep 2003 09:25:19 -0000 1.8
+++ number.t 22 Sep 2003 15:01:01 -0000 1.9
@@ -23,7 +23,7 @@
use Parrot::Test tests => 3;
SKIP: {
-#skip("core ops changes", 2);
+ skip("core ops changes", 2);
output_is(<<CODE, <<OUTPUT, "i386 double float 32 bit opcode_t");
# number_1.pbc
1.7 +68 -20 parrot/t/op/bitwise.t
Index: bitwise.t
===================================================================
RCS file: /cvs/public/parrot/t/op/bitwise.t,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- bitwise.t 21 Aug 2002 05:03:39 -0000 1.6
+++ bitwise.t 22 Sep 2003 15:01:06 -0000 1.7
@@ -1,8 +1,8 @@
#perl -w
-use Parrot::Test tests => 20;
+use Parrot::Test tests => 23;
-output_is(<<'CODE', <<'OUTPUT', "shr_i_i (>>)");
+output_is(<<'CODE', <<'OUTPUT', "shr_i_i_i (>>)");
set I0, 0b001100
set I1, 0b010100
set I2, 1
@@ -26,7 +26,24 @@
12
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "shr_i_ic (>>)");
+output_is(<<'CODE', <<'OUTPUT', "shr_i_i (>>)");
+ set I0, 0b001100
+ set I1, 0b010100
+ set I2, 1
+ set I3, 2
+ shr I0, I2
+ shr I1, I3
+ print I0
+ print "\n"
+ print I1
+ print "\n"
+ end
+CODE
+6
+5
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "shr_i_i_ic (>>)");
set I0, 0b001100
set I1, 0b010100
shr I2, I0, 1
@@ -44,7 +61,7 @@
12
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "shr_ic_i (>>)");
+output_is(<<'CODE', <<'OUTPUT', "shr_i_ic_i (>>)");
set I0, 1
set I1, 2
shr I2, 0b001100, I0
@@ -59,7 +76,7 @@
5
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "shr_ic_ic (>>)");
+output_is(<<'CODE', <<'OUTPUT', "shr_i_ic_ic (>>)");
shr I2, 0b001100, 1
shr I1, 0b010100, 2
print I2
@@ -75,7 +92,7 @@
# The crux of this test is that a proper logical right shift
# will clear the most significant bit, so the shifted value
# will be a positive value on any 2's or 1's complement CPU
-output_is(<<'CODE', <<'OUTPUT', "lsr_ic_ic (<<)");
+output_is(<<'CODE', <<'OUTPUT', "lsr_i_ic_ic (>>)");
lsr I2, -40, 1
lt I2, 0, BAD
print "OK\n"
@@ -88,7 +105,21 @@
OK
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "lsr_i_i (<<)");
+output_is(<<'CODE', <<'OUTPUT', "lsr_i_ic (>>)");
+ set I2, -100
+ lsr I2, 1
+ lt I2, 0, BAD
+ print "OK\n"
+ end
+BAD:
+ print "Not OK"
+ print "\n"
+ end
+CODE
+OK
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "lsr_i_i_i (<<)");
set I0, -40
set I1, 1
lsr I2, I0, I1
@@ -103,7 +134,7 @@
OK
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "shl_i_i (<<)");
+output_is(<<'CODE', <<'OUTPUT', "shl_i_i_i (<<)");
set I0, 0b001100
set I1, 0b010100
set I2, 2
@@ -127,7 +158,7 @@
12
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "shl_i_ic (<<)");
+output_is(<<'CODE', <<'OUTPUT', "shl_i_i_ic (<<)");
set I0, 0b001100
set I1, 0b010100
shl I2, I0, 2
@@ -145,7 +176,7 @@
12
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "shl_ic_i (<<)");
+output_is(<<'CODE', <<'OUTPUT', "shl_i_ic_i (<<)");
set I0, 2
set I1, 1
shl I2, 0b001100, I0
@@ -160,7 +191,7 @@
40
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "shl_ic_ic (<<)");
+output_is(<<'CODE', <<'OUTPUT', "shl_i_ic_ic (<<)");
shl I2, 0b001100, 2
shl I1, 0b010100, 1
print I2
@@ -173,7 +204,24 @@
40
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "bxor_i_i (^)");
+output_is(<<'CODE', <<'OUTPUT', "shl_i_i (<<)");
+ set I0, 0b001100
+ set I1, 0b010100
+ set I2, 1
+ set I3, 2
+ shl I0, I2
+ shl I1, I3
+ print I0
+ print "\n"
+ print I1
+ print "\n"
+ end
+CODE
+24
+80
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "bxor_i_i_i (^)");
set I0, 0b001100
set I1, 0b100110
bxor I2, I0, I1
@@ -191,7 +239,7 @@
12
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "bxor_i_ic (^)");
+output_is(<<'CODE', <<'OUTPUT', "bxor_i_i_ic (^)");
set I0, 0b001100
bxor I2, I0, 0b100110
print I2
@@ -238,7 +286,7 @@
22
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "band_i_i (&)");
+output_is(<<'CODE', <<'OUTPUT', "band_i_i_i (&)");
set I0, 0b001100
set I1, 0b010110
band I2, I0,I1
@@ -256,7 +304,7 @@
12
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "band_i_ic (&)");
+output_is(<<'CODE', <<'OUTPUT', "band_i_i_ic (&)");
set I0, 0b001100
band I2, I0,0b010110
print I2
@@ -273,7 +321,7 @@
4
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "band_i|ic (&)");
+output_is(<<'CODE', <<'OUTPUT', "band_i_i|ic (&)");
set I0, 0b001100
set I2, 0b000011
band I2, I0
@@ -303,7 +351,7 @@
1
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "bor_i_i (|)");
+output_is(<<'CODE', <<'OUTPUT', "bor_i_i_i (|)");
set I0, 0b001100
set I1, 0b010110
bor I2, I0,I1
@@ -321,7 +369,7 @@
12
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "bor_i_ic (|)");
+output_is(<<'CODE', <<'OUTPUT', "bor_i_i_ic (|)");
set I0, 0b001100
bor I2, I0,0b010110
print I2
@@ -338,7 +386,7 @@
30
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "bor_i|ic (|)");
+output_is(<<'CODE', <<'OUTPUT', "bor_i_i|ic (|)");
set I0, 0b001100
set I2, 0b000011
bor I2, I0
@@ -369,7 +417,7 @@
OUTPUT
# use C<and> to only check low order bits, this should be platform nice
-output_is(<<'CODE', <<'OUTPUT', "bnot_i (~)");
+output_is(<<'CODE', <<'OUTPUT', "bnot_i_i (~)");
set I0, 0b001100
set I1, 0b001100
set I31, 0b111111
1.10 +25 -25 parrot/t/pmc/perlint.t
Index: perlint.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlint.t,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- perlint.t 11 Sep 2003 14:48:53 -0000 1.9
+++ perlint.t 22 Sep 2003 15:01:08 -0000 1.10
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 19;
+use Parrot::Test tests => 18;
use Parrot::PMC '%pmc_types';
my $perlint = $pmc_types{'PerlInt'};
my $ok = '"ok 1\n"';
@@ -83,28 +83,6 @@
ok 2
OUTPUT
-SKIP: { skip("add_keyed: not yet", 1);
-output_is(<<'CODE', <<'OUTPUT', "add_keyed");
-# add keyed
- new P2, .PerlArray
- set P2[10], 10
- set P0, 20
- new P11, .Key
- new P12, .Key
- new P13, .Key
- set P12,10
- add P1[P11],P2[P12],P0[P13]
- set I1,P1
- eq I1,30,ok_3
- print "not "
-ok_3:
- print "ok 1\n"
-
- end
-CODE
-ok 1
-OUTPUT
-}
output_is(<<'CODE', <<'OUTPUT', "bor");
new P0, .PerlInt
@@ -309,7 +287,7 @@
shr P4, P0, P2
shr P5, P0, P3
shr P6, P1, P2
- shr P7, P1, P3
+ shr P7, P1, 2
print P4
print "\n"
@@ -319,12 +297,23 @@
print "\n"
print P7
print "\n"
+
+ set P0, 0b001100
+ set P1, 0b010100
+ shr P0, P2
+ shr P1, 2
+ print P0
+ print "\n"
+ print P1
+ print "\n"
end
CODE
6
3
10
5
+6
+5
OUTPUT
output_is(<<'CODE', <<'OUTPUT', "shl (<<)");
@@ -345,7 +334,7 @@
shl P4, P0, P2
shl P5, P0, P3
shl P6, P1, P2
- shl P7, P1, P3
+ shl P7, P1, 2
print P4
print "\n"
@@ -355,11 +344,22 @@
print "\n"
print P7
print "\n"
+
+ set P0, 0b001100
+ set P1, 0b010100
+ shl P0, P2
+ shl P1, 2
+ print P0
+ print "\n"
+ print P1
+ print "\n"
end
CODE
24
48
40
+80
+24
80
OUTPUT
