cvsuser 01/09/15 13:46:36
Modified: . assemble.pl basic_opcodes.ops opcode_table
Log:
New ops for register-constant INTEGER comparisons:
{eq,ne,lt,le,gt,ge}_ic_ic
New ops for register-register and register-constant NUMERIC comparisons:
eq_nc_ic
{ne,lt,le,gt,ge}_{n,nc}_ic
Assembler:
Allow uppercase and underscores in labels.
Tweaks to the op infer code to make it work with the examples I've been
creating.
Revision Changes Path
1.22 +25 -16 parrot/assemble.pl
Index: assemble.pl
===================================================================
RCS file: /home/perlcvs/parrot/assemble.pl,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -w -r1.21 -r1.22
--- assemble.pl 2001/09/15 15:45:28 1.21
+++ assemble.pl 2001/09/15 20:46:36 1.22
@@ -18,7 +18,7 @@
'listing=s'));
if($options{'version'}) {
- print $0,'Version $Id: assemble.pl,v 1.21 2001/09/15 15:45:28 mon Exp $ ',"\n";
+ print $0,'Version $Id: assemble.pl,v 1.22 2001/09/15 20:46:36 gregor Exp $
',"\n";
exit;
}
@@ -121,7 +121,7 @@
} elsif(m/^((-?\d+)|(0b[01]+)|(0x[0-9a-f]+))$/i) {
# integer
push @arg_t,'ic';
- } elsif(m/^[a-z][\w]*$/i) {
+ } elsif(m/^[A-Za-z_][\w]*$/i) {
# label
push @arg_t,'ic';
} else {
@@ -130,23 +130,32 @@
}
}
}
+
+ my $found_op = 0;
+ my @tests;
my $test;
- my($first,$last)=($arg_t[0],$arg_t[-1]);
- if($first ne $last) {
- $test="${opcode}_${first}_$last";
+
+ #
+ # For many-arg ops, if first two arg types have the same basic type (like
'i' and 'ic'),
+ # shift off the first one.
+ #
+
+ shift @arg_t if (@arg_t > 2) and (substr($arg_t[0],0,1) eq
substr($arg_t[1],0,1));
+
+ while (@arg_t) {
+ $test = $opcode . '_' . join('_', @arg_t);
+ push @tests, $test;
+ $found_op++, last if $opcodes{$test};
+ pop @arg_t;
+ }
+
+ if ($found_op) {
+ pop @tests;
+ log_message("substituting $test for $opcode" . (scalar(@tests) ? ("
(tried " . join(', ', @tests) . ")") : ''));
+ $opcode = $test;
} else {
- $test="${opcode}_$first";
- }
- my($found_op)=0;
- foreach my $op (grep($_=~/^$opcode/,keys(%opcodes))) {
- if($op eq $test) {
- log_message("substituting $op for $opcode");
- $opcode=$op;
- $found_op=1;
- last;
- }
+ error("No opcode $opcode (tried " . join(', ', @tests) . ") in <$_>");
}
- error("No opcode $opcode in <$_>") if(!$found_op);
}
if (@args != $opcodes{$opcode}{ARGS}) {
error("Wrong arg count--got ".scalar(@args)." needed
".$opcodes{$opcode}{ARGS});
1.16 +153 -0 parrot/basic_opcodes.ops
Index: basic_opcodes.ops
===================================================================
RCS file: /home/perlcvs/parrot/basic_opcodes.ops,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- basic_opcodes.ops 2001/09/14 14:08:00 1.15
+++ basic_opcodes.ops 2001/09/15 20:46:36 1.16
@@ -56,6 +56,15 @@
}
}
+/* EQ Ix, CONSTANT, EQ_BRANCH, NE_BRANCH */
+MANUAL_OP eq_ic_ic {
+ if (INT_REG(P1) == P2) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
/* NE Ix, Iy, NE_BRANCH, EQ_BRANCH */
MANUAL_OP ne_i_ic {
if (INT_REG(P1) != INT_REG(P2)) {
@@ -65,6 +74,15 @@
}
}
+/* NE Ix, CONSTANT, NE_BRANCH, EQ_BRANCH */
+MANUAL_OP ne_ic_ic {
+ if (INT_REG(P1) != P2) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
/* LT Ix, Iy, LT_BRANCH, GE_BRANCH */
MANUAL_OP lt_i_ic {
if (INT_REG(P1) < INT_REG(P2)) {
@@ -74,6 +92,15 @@
}
}
+/* LT Ix, CONSTANT, LT_BRANCH, GE_BRANCH */
+MANUAL_OP lt_ic_ic {
+ if (INT_REG(P1) < P2) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
/* LE Ix, Iy, LE_BRANCH, GT_BRANCH */
MANUAL_OP le_i_ic {
if (INT_REG(P1) <= INT_REG(P2)) {
@@ -83,6 +110,15 @@
}
}
+/* LE Ix, CONSTANT, LE_BRANCH, GT_BRANCH */
+MANUAL_OP le_ic_ic {
+ if (INT_REG(P1) <= P2) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
/* GT Ix, Iy, GT_BRANCH, LE_BRANCH */
MANUAL_OP gt_i_ic {
if (INT_REG(P1) > INT_REG(P2)) {
@@ -92,6 +128,15 @@
}
}
+/* GT Ix, CONSTANT, GT_BRANCH, LE_BRANCH */
+MANUAL_OP gt_ic_ic {
+ if (INT_REG(P1) > P2) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
/* GE Ix, Iy, GE_BRANCH, LT_BRANCH */
MANUAL_OP ge_i_ic {
if (INT_REG(P1) >= INT_REG(P2)) {
@@ -101,6 +146,15 @@
}
}
+/* GE Ix, CONSTANT, GE_BRANCH, LT_BRANCH */
+MANUAL_OP ge_ic_ic {
+ if (INT_REG(P1) >= P2) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
/* IF IXx, TRUE_BRANCH, FALSE_BRANCH */
MANUAL_OP if_i_ic {
if (INT_REG(P1)) {
@@ -193,6 +247,105 @@
/* EQ Nx, Ny, EQ_BRANCH, NE_BRANCH */
MANUAL_OP eq_n_ic {
if (NUM_REG(P1) == NUM_REG(P2)) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
+/* EQ Nx, CONSTANT, EQ_BRANCH, NE_BRANCH */
+MANUAL_OP eq_nc_ic {
+ if (NUM_REG(P1) == P2) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
+/* NE Nx, Ny, NE_BRANCH, EQ_BRANCH */
+MANUAL_OP ne_n_ic {
+ if (NUM_REG(P1) != NUM_REG(P2)) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
+/* NE Nx, CONSTANT, NE_BRANCH, EQ_BRANCH */
+MANUAL_OP ne_nc_ic {
+ if (NUM_REG(P1) != P2) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
+/* LT Nx, Ny, LT_BRANCH, GE_BRANCH */
+MANUAL_OP lt_n_ic {
+ if (NUM_REG(P1) < NUM_REG(P2)) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
+/* LT Nx, CONSTANT, LT_BRANCH, GE_BRANCH */
+MANUAL_OP lt_nc_ic {
+ if (NUM_REG(P1) < P2) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
+/* LE Nx, Ny, LE_BRANCH, GT_BRANCH */
+MANUAL_OP le_n_ic {
+ if (NUM_REG(P1) <= NUM_REG(P2)) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
+/* LE Nx, CONSTANT, LE_BRANCH, GT_BRANCH */
+MANUAL_OP le_nc_ic {
+ if (NUM_REG(P1) <= P2) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
+/* GT Nx, Ny, GT_BRANCH, LE_BRANCH */
+MANUAL_OP gt_n_ic {
+ if (NUM_REG(P1) > NUM_REG(P2)) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
+/* GT Nx, CONSTANT, GT_BRANCH, LE_BRANCH */
+MANUAL_OP gt_nc_ic {
+ if (NUM_REG(P1) > P2) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
+/* GE Nx, Ny, GE_BRANCH, LT_BRANCH */
+MANUAL_OP ge_n_ic {
+ if (NUM_REG(P1) >= NUM_REG(P2)) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
+/* GE Nx, CONSTANT, GE_BRANCH, LT_BRANCH */
+MANUAL_OP ge_nc_ic {
+ if (NUM_REG(P1) >= P2) {
RETURN(P3);
} else {
RETURN(P4);
1.14 +20 -2 parrot/opcode_table
Index: opcode_table
===================================================================
RCS file: /home/perlcvs/parrot/opcode_table,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- opcode_table 2001/09/13 16:16:38 1.13
+++ opcode_table 2001/09/15 20:46:36 1.14
@@ -59,15 +59,33 @@
chopn_s_ic 2 S i
substr_s_s_i 4 S S I I
-# Comparators
+# Comparators (TODO: String comparators)
eq_i_ic 4 I I D D
-eq_n_ic 4 N N D D
+eq_ic_ic 4 I i D D
ne_i_ic 4 I I D D
+ne_ic_ic 4 I i D D
lt_i_ic 4 I I D D
+lt_ic_ic 4 I i D D
le_i_ic 4 I I D D
+le_ic_ic 4 I i D D
gt_i_ic 4 I I D D
+gt_ic_ic 4 I i D D
ge_i_ic 4 I I D D
+ge_ic_ic 4 I i D D
+
+eq_n_ic 4 N N D D
+eq_nc_ic 4 N n D D
+ne_n_ic 4 N N D D
+ne_nc_ic 4 N n D D
+lt_n_ic 4 N N D D
+lt_nc_ic 4 N n D D
+le_n_ic 4 N N D D
+le_nc_ic 4 N n D D
+gt_n_ic 4 N N D D
+gt_nc_ic 4 N n D D
+ge_n_ic 4 N N D D
+ge_nc_ic 4 N n D D
# Flow control
