simon 01/09/13 09:16:39
Modified: . assemble.pl basic_opcodes.ops opcode_table
Log:
From Brian Wheeler:
This patch gives the assembler support of '\a','\n','\r','\t', and '\\'
in string constants.
In addition, it changes (for all registers) "I reg %li is ..." to just
the value of the register. Printing constants is also supported, but
alas, you have to specify the type (print_sc, print_ic, print_nc).
Revision Changes Path
1.13 +7 -5 parrot/assemble.pl
Index: assemble.pl
===================================================================
RCS file: /home/perlcvs/parrot/assemble.pl,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -w -r1.12 -r1.13
--- assemble.pl 2001/09/13 14:38:31 1.12
+++ assemble.pl 2001/09/13 16:16:38 1.13
@@ -109,7 +109,7 @@
}
my($found_op)=0;
foreach my $op (grep($_=~/^$opcode/,keys(%opcodes))) {
- if($op=~/$test/) {
+ if($op=~/^$test$/) {
$opcode=$op;
$found_op=1;
last;
@@ -118,8 +118,7 @@
error("No opcode $opcode in <$_>") if(!$found_op);
}
if (@args != $opcodes{$opcode}{ARGS}) {
- error("Wrong arg count--got ".scalar(@args)." needed
-".$opcodes{$opcode}{ARGS});
+ error("Wrong arg count--got ".scalar(@args)." needed
".$opcodes{$opcode}{ARGS});
}
$bytecode .= pack "l", $opcodes{$opcode}{CODE};
$op_pc=$pc;
@@ -128,8 +127,7 @@
foreach (0..$#args) {
my($rtype)=$opcodes{$opcode}{RTYPES}[$_];
my($type)=$opcodes{$opcode}{TYPES}[$_];
- if($rtype eq "I" || $rtype eq "N" || $rtype eq "P" || $rtype eq
-"S") {
+ if($rtype eq "I" || $rtype eq "N" || $rtype eq "P" || $rtype eq "S") {
# its a register argument
$args[$_]=~s/^[INPS](\d+)$/$1/i;
$pc+=$sizeof{$rtype}
@@ -217,7 +215,11 @@
sub constantize {
my $s = shift;
+ # handle \ characters in the constant
+ my %escape = ('a'=>"\a",'n'=>"\n",'r'=>"\r",'t'=>"\t",'\\'=>'\\',);
+ $s=~s/\\([anrt\\])/$escape{$1}/g;
return $constants{$s} if exists $constants{$s};
push @constants, $s;
return $constants{$s} = $#constants;
}
+
1.14 +21 -3 parrot/basic_opcodes.ops
Index: basic_opcodes.ops
===================================================================
RCS file: /home/perlcvs/parrot/basic_opcodes.ops,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- basic_opcodes.ops 2001/09/13 08:44:07 1.13
+++ basic_opcodes.ops 2001/09/13 16:16:38 1.14
@@ -117,9 +117,15 @@
/* PRINT Ix */
AUTO_OP print_i {
- printf("I reg %li is %li\n", P1, INT_REG(P1));
+ printf("%li", INT_REG(P1));
}
+/* PRINT ic */
+AUTO_OP print_ic {
+ printf("%li", P1);
+}
+
+
/* BRANCH CONSTANT */
MANUAL_OP branch_ic {
RETURN(P1);
@@ -209,7 +215,12 @@
/* PRINT Nx */
AUTO_OP print_n {
- printf("N reg %li is %f\n", P1, NUM_REG(P1));
+ printf("%f", NUM_REG(P1));
+}
+
+/* PRINT nc */
+AUTO_OP print_nc {
+ printf("%f", P1);
}
/* INC Nx */
@@ -314,8 +325,15 @@
/* PRINT Sx */
AUTO_OP print_s {
STRING *s = STR_REG(P1);
- printf("S reg %li is %.*s\n", P1, (int) string_length(s), (char *) s->bufstart);
+ printf("%.*s",(int)string_length(s),(char *) s->bufstart);
+}
+
+/* PRINT sc */
+AUTO_OP print_sc {
+ STRING *s = Parrot_string_constants[P1];
+ printf("%.*s",(int)string_length(s),(char *) s->bufstart);
}
+
/* LEN Ix, Sx */
AUTO_OP length_i_s {
1.13 +3 -0 parrot/opcode_table
Index: opcode_table
===================================================================
RCS file: /home/perlcvs/parrot/opcode_table,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -w -r1.12 -r1.13
--- opcode_table 2001/09/13 07:27:46 1.12
+++ opcode_table 2001/09/13 16:16:38 1.13
@@ -54,6 +54,7 @@
set_s_sc 2 S s
print_s 1 S
+print_sc 1 s
length_i_s 2 I S
chopn_s_ic 2 S i
substr_s_s_i 4 S S I I
@@ -84,8 +85,10 @@
time_i 1 I
print_i 1 I
+print_ic 1 i
time_n 1 N
print_n 1 N
+print_nc 1 n
noop 0
# Register ops
