On Mon, 2001-09-10 at 19:54, Dan Sugalski wrote:
> At 07:45 PM 9/10/2001 -0500, Brian Wheeler wrote:
> >If eq_i_ic is really treated as /eq(_i)+_ic/ then this code still
> >doesn't work:
> >
> >eq_i_ic I1,I2,NEXT,DONE
> >
> >because that'd be like eq_i_i_ic_ic, right?
>
> Right. But don't forget, I screwed up the eq op--it ought to have a single
> destination. :)
>
DOH! That's the trick :)
> >I assume that opcodes aren't going to have variable arguments at this level,
> >so there should be a one-to-one mapping between function and opcode, right?
>
> Each opcode number has a single function, yes. The same "high-level"
> opcode, for example eq or add, might map to two or more different 'real'
> opcodes based on the types of the args. There won't be any runtime
> morphing--it's more "The assembler sees the first arg of foo as a numberic
> register and the second as a constant, so it must be foo_n_nc".
>
> >A thought (though gross): if we restrict mneumonics to not use the
> >underscore,
> >then anything after _ can be the op signature.
>
> Too gross. We don't need to go there. :)
>
Just checking.
> >Also, doing it this way takes out the special cases for the comparison and
> >jump ops: the fixups are known to be done with things that have type 'a'
>
> The jump ops will be easy to figure--either they'll take a register, a
> constant number, or a label. We don't allow labels that could be confused
> with registers. (No I0: anywhere...)
>
>
I've had more thoughts about my first patch. The case issue isn't an
issue since it only touches the generation tools, not the C code that's
generated (at least, not directly).
It also provides the additional information needed to let the assembler
choose the correct opcode, and the disassembler to dump things nicely :)
I've also fixed up the supporting tools. As a test case, I rebuilt
test_prog, assembled test.parm, ran it and dissassembled it. Looks for
for that one, at least :)
Please consider this new patch.
Brian
Index: assemble.pl
===================================================================
RCS file: /home/perlcvs/parrot/assemble.pl,v
retrieving revision 1.6
diff -u -r1.6 assemble.pl
--- assemble.pl 2001/09/10 21:26:08 1.6
+++ assemble.pl 2001/09/11 02:02:15
@@ -9,7 +9,16 @@
my %pack_type;
%pack_type = (i => 'l',
n => 'd',
- );
+ );
+
+my %real_type=('i'=>'i',
+ 'n'=>'n',
+ 'N'=>'i',
+ 'I'=>'i',
+ 'S'=>'i',
+ 's'=>'i',
+ 'D'=>'i');
+
my $sizeof_packi = length(pack($pack_type{i},1024));
open GUTS, "interp_guts.h";
@@ -26,8 +35,11 @@
s/^\s+//;
next unless $_;
my ($name, $args, @types) = split /\s+/, $_;
+ my @rtypes=@types;
+ @types=map { $_ = $real_type{$_}} @types;
$opcodes{$name}{ARGS} = $args;
$opcodes{$name}{TYPES} = [@types];
+ $opcodes{$name}{RTYPES}=[@rtypes];
}
my $pc = 0;
@@ -65,23 +77,17 @@
die "wrong arg count--got ". scalar @args. " needed " .
$opcodes{$opcode}{ARGS};
}
- $args[0] = fixup($args[0])
- if $opcode eq "branch_ic" and $args[0] =~ /[a-zA-Z]/;
-
-# if ($opcode eq "eq_i_ic" or $opcode eq "lt_i_ic") {
- if ($opcode =~ /^(eq|ne|lt|le|gt|ge)_i_ic$/) {
- $args[2] = fixup($args[2]) if $args[2] =~ /[a-zA-Z]/;
- $args[3] = fixup($args[3]) if $args[3] =~ /[a-zA-Z]/;
- }
- if ($opcode eq "if_i_ic") {
- $args[1] = fixup($args[1]) if $args[1] =~ /[a-zA-Z]/;
- $args[2] = fixup($args[2]) if $args[2] =~ /[a-zA-Z]/;
- }
-
print pack "l", $opcodes{$opcode}{CODE};
foreach (0..$#args) {
- $args[$_] =~ s/^[INPS]?(\d+)$/$1/i;
- my $type = $pack_type{$opcodes{$opcode}{TYPES}[$_]};
+ my($rtype)=$opcodes{$opcode}{RTYPES}[$_];
+ my($type)=$opcodes{$opcode}{TYPES}[$_];
+ if($rtype eq "I" || $rtype eq "N" || $rtype eq "P" || $rtype eq "S") {
+ # its a register argument
+ $args[$_]=~s/^[INPS](\d+)$/$1/i;
+ } elsif($rtype eq "D") {
+ # a destination
+ $args[$_]=fixup($args[$_]);
+ }
print pack $type, $args[$_];
}
$pc += 1+@args;
Index: disassemble.pl
===================================================================
RCS file: /home/perlcvs/parrot/disassemble.pl,v
retrieving revision 1.3
diff -u -r1.3 disassemble.pl
--- disassemble.pl 2001/09/10 21:45:33 1.3
+++ disassemble.pl 2001/09/11 02:02:16
@@ -8,14 +8,25 @@
my(%opcodes, @opcodes);
-my %unpack_type;
-%unpack_type = (i => 'l',
- n => 'd',
- );
+
+my %unpack_type = (i => 'l',
+ I => 'l',
+ n => 'd',
+ N => 'l',
+ D => 'l',
+ S => 'l',
+ s => 'l',
+ );
my %unpack_size = (i => 4,
n => 8,
+ I => 4,
+ N => 4,
+ D => 4,
+ S => 4,
+ s => 4,
);
+
open GUTS, "interp_guts.h";
my $opcode;
while (<GUTS>) {
@@ -51,15 +62,29 @@
my $constants = unpack('l', <>);
# Skip for now
+my $offset=0;
while (<>) {
my $code = unpack 'l', $_;
my $args = $opcodes[$code]{ARGS};
- print $opcodes[$code]{NAME};
+ my $op_offset=$offset;
+ print sprintf("%08x ",$offset),$opcodes[$code]{NAME};
+ $offset+=4;
if ($args) {
foreach (1..$args) {
- local $/ = \$unpack_size{$opcodes[$code]{TYPES}[$_-1]};
+ my $type=$opcodes[$code]{TYPES}[$_-1];
+ local $/ = \$unpack_size{$type};
+ $offset+=$unpack_size{$type};
my $data = <> || die("EOF when expecting argument!\n");
- print " ", unpack $unpack_type{$opcodes[$code]{TYPES}[$_-1]},
$data;+ if($type eq "I" || $type eq "N" || $type eq "P" || $type eq
"S") {
+ # register
+ print " ",$type,unpack($unpack_type{$type},$data);
+ } elsif($type eq "D") {
+ # destination address
+ print "
",sprintf("%08x",$op_offset+unpack($unpack_type{$type},$data)*4);
+ } else {
+ # constant
+ print " ", unpack $unpack_type{$type}, $data;
+ }
}
}
print "\n";
Index: opcode_table
===================================================================
RCS file: /home/perlcvs/parrot/opcode_table,v
retrieving revision 1.6
diff -u -r1.6 opcode_table
--- opcode_table 2001/09/10 21:26:09 1.6
+++ opcode_table 2001/09/11 02:02:16
@@ -11,70 +11,80 @@
# not the type of the register or anything. So N3 is still an i, since
that
# 3 specifying the register should be packed as an integer.
+# Revised arg types:
+# i Integer constant
+# I Integer register
+# n Numeric constant
+# N Numeric register
+# s String constant?
+# S String register
+# D Destination
+
+
# This must be opcode zero
end 0
# Integer ops
-set_i_ic 2 i i
-set_i 2 i i
-add_i 3 i i i
-sub_i 3 i i i
-mul_i 3 i i i
-div_i 3 i i i
-inc_i 1 i
-inc_i_ic 2 i i
-dec_i 1 i
-dec_i_ic 2 i i
+set_i_ic 2 I i
+set_i 2 I I
+add_i 3 I I I
+sub_i 3 I I I
+mul_i 3 I I I
+div_i 3 I I I
+inc_i 1 I
+inc_i_ic 2 I i
+dec_i 1 I
+dec_i_ic 2 I i
# NUM ops
-set_n_nc 2 i n
-add_n 3 i i i
-sub_n 3 i i i
-mul_n 3 i i i
-div_n 3 i i i
-inc_n 1 i
-inc_n_nc 2 i n
-dec_n 1 i
-dec_n_nc 2 i n
+set_n_nc 2 N n
+add_n 3 N N N
+sub_n 3 N N N
+mul_n 3 N N N
+div_n 3 N N N
+inc_n 1 N
+inc_n_nc 2 N n
+dec_n 1 N
+dec_n_nc 2 N n
# String ops
-set_s_sc 2 i i
-print_s 1 i
-length_s_i 2 i i
-chopn_s_ic 2 i i
+set_s_sc 2 S s
+print_s 1 S
+length_s_i 2 S I
+chopn_s_ic 2 S i
# Comparators
-eq_i_ic 4 i i i i
-eq_n_ic 4 i i i i
-ne_i_ic 4 i i i i
-lt_i_ic 4 i i i i
-le_i_ic 4 i i i i
-gt_i_ic 4 i i i i
-ge_i_ic 4 i i i i
+eq_i_ic 4 I I D D
+eq_n_ic 4 N N D D
+ne_i_ic 4 I I D D
+lt_i_ic 4 I I D D
+le_i_ic 4 I I D D
+gt_i_ic 4 I I D D
+ge_i_ic 4 I I D D
# Flow control
-jump_i 1 i
-branch_ic 1 i
-if_i_ic 3 i i i
-if_n_ic 3 i i i
+jump_i 1 D
+branch_ic 1 D
+if_i_ic 3 I D D
+if_n_ic 3 N D D
# Convertors
-iton_n_i 2 i i
-ntoi_i_n 2 i i
+iton_n_i 2 N I
+ntoi_i_n 2 I N
# Miscellaneous and debugging ops
-time_i 1 i
-print_i 1 i
-time_n 1 i
-print_n 1 i
+time_i 1 I
+print_i 1 I
+time_n 1 N
+print_n 1 N
noop 0
# Register ops
Index: process_opfunc.pl
===================================================================
RCS file: /home/perlcvs/parrot/process_opfunc.pl,v
retrieving revision 1.3
diff -u -r1.3 process_opfunc.pl
--- process_opfunc.pl 2001/09/10 21:26:09 1.3
+++ process_opfunc.pl 2001/09/11 02:02:16
@@ -40,6 +40,17 @@
$opcode{$2}{OPNUM} = $1;
}
+
+my %psize = (i => 1,
+ n => 2,
+ I => 1,
+ N => 1,
+ D => 1,
+ S => 1,
+ s => 1,
+ );
+
+
open OPCODE, "opcode_table" or die "Can't open opcode_table, $!/$^E";
while (<OPCODE>) {
s/#.*//;
@@ -49,10 +60,13 @@
my ($name, $params, @params) = split /\s+/;
$opcode{$name}{PARAM_COUNT} = $params;
$opcode{$name}{PARAM_ARRAY} = \@params;
+
+ my $psize=0;
+ foreach (@params) {
+ $psize+=$psize{$_};
+ }
- my $num_i = () = grep {/i/} @params;
- my $num_n = () = grep {/n/} @params;
- $opcode{$name}{RETURN_OFFSET} = 1 + $num_i + $num_n * 2;
+ $opcode{$name}{RETURN_OFFSET} = 1 + $psize;
my $count = 1;
$opcode{$name}{PARAMETER_SUB} = ["",
map {if ($_ eq "n") {
