simon 01/09/10 14:26:10
Modified: . Makefile TODO assemble.pl basic_opcodes.ops
build_interp_starter.pl disassemble.pl
make_op_header.pl opcode_table process_opfunc.pl
Log:
Automatic opcode numbering, from Leon Brocard <[EMAIL PROTECTED]>.
This means we can add lots more opcodes without fiddling about with
the numbers. Hooray!
Don't forget that "end" needs to be op zero, else the interpreter
falls off the end of the code. This is Bad, and I wonder if there's a
way around it.
Revision Changes Path
1.6 +3 -3 parrot/Makefile
Index: Makefile
===================================================================
RCS file: /home/perlcvs/parrot/Makefile,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- Makefile 2001/09/10 18:46:46 1.5
+++ Makefile 2001/09/10 21:26:08 1.6
@@ -22,7 +22,7 @@
strnative$(O): $(H_FILES)
-interp_guts.h: opcode_table
+interp_guts.h: opcode_table build_interp_starter.pl
perl build_interp_starter.pl
interpreter$(O): interpreter.c $(H_FILES) interp_guts.h
@@ -37,10 +37,10 @@
basic_opcodes$(O): $(H_FILES) basic_opcodes.c
-basic_opcodes.c: basic_opcodes.ops
+basic_opcodes.c: basic_opcodes.ops process_opfunc.pl interp_guts.h
perl process_opfunc.pl basic_opcodes.ops
-op.h: opcode_table
+op.h: opcode_table make_op_header.pl
perl make_op_header.pl opcode_table > op.h
clean:
1.4 +0 -1 parrot/TODO
Index: TODO
===================================================================
RCS file: /home/perlcvs/parrot/TODO,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- TODO 2001/09/10 16:02:57 1.3
+++ TODO 2001/09/10 21:26:08 1.4
@@ -1,4 +1,3 @@
-Automate numbering of opcodes - this is paramount
Add a configure system - this is relatively paramount
grep docs/strings.pod for unimplemented functions and implement them
1.6 +15 -9 parrot/assemble.pl
Index: assemble.pl
===================================================================
RCS file: /home/perlcvs/parrot/assemble.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- assemble.pl 2001/09/10 17:30:29 1.5
+++ assemble.pl 2001/09/10 21:26:08 1.6
@@ -12,6 +12,12 @@
);
my $sizeof_packi = length(pack($pack_type{i},1024));
+open GUTS, "interp_guts.h";
+my $opcode;
+while (<GUTS>) {
+ next unless /\tx\[(\d+)\] = ([a-z_]+);/;
+ $opcodes{$2}{CODE} = $1;
+}
open OPCODES, "<opcode_table" or die "Can't get opcode table, $!/$^E";
while (<OPCODES>) {
@@ -19,11 +25,9 @@
chomp;
s/^\s+//;
next unless $_;
- my ($code, $name, $args, @types) = split /\s+/, $_;
- $opcodes{$name} = {CODE => $code,
- ARGS => $args,
- TYPES => [@types]
- };
+ my ($name, $args, @types) = split /\s+/, $_;
+ $opcodes{$name}{ARGS} = $args;
+ $opcodes{$name}{TYPES} = [@types];
}
my $pc = 0;
@@ -33,6 +37,7 @@
# First scan for labels and strings
while (<>) {
+ next if /^\s?#/;
s/^\s*//;
if (s/^\s*([a-zA-Z_]\w+):\s*//) { $labels{$1} = $pc; }
1 while s/\"([^\\\"]*(?:\\.[^\\\"]*)*)\"/constantize($1)/eg;
@@ -63,7 +68,8 @@
$args[0] = fixup($args[0])
if $opcode eq "branch_ic" and $args[0] =~ /[a-zA-Z]/;
- if ($opcode eq "eq_i_ic") {
+# 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]/;
}
1.5 +51 -1 parrot/basic_opcodes.ops
Index: basic_opcodes.ops
===================================================================
RCS file: /home/perlcvs/parrot/basic_opcodes.ops,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- basic_opcodes.ops 2001/09/10 15:48:36 1.4
+++ basic_opcodes.ops 2001/09/10 21:26:08 1.5
@@ -11,6 +11,11 @@
INT_REG(P1) = P2;
}
+// SET Ix, Ix
+AUTO_OP set_i {
+ INT_REG(P1) = INT_REG(P2);
+}
+
// ADD Ix, Iy, Iz
AUTO_OP add_i {
INT_REG(P1) = INT_REG(P2) +
@@ -44,6 +49,51 @@
}
}
+// NE Ix, Iy, NE_BRANCH, EQ_BRANCH
+MANUAL_OP ne_i_ic {
+ if (INT_REG(P1) != INT_REG(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)) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
+// LE Ix, Iy, LE_BRANCH, GT_BRANCH
+MANUAL_OP le_i_ic {
+ if (INT_REG(P1) <= INT_REG(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)) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
+// GE Ix, Iy, GE_BRANCH, LT_BRANCH
+MANUAL_OP ge_i_ic {
+ if (INT_REG(P1) >= INT_REG(P2)) {
+ RETURN(P3);
+ } else {
+ RETURN(P4);
+ }
+}
+
// IF IXx, TRUE_BRANCH, FALSE_BRANCH
MANUAL_OP if_i_ic {
if (INT_REG(P1)) {
1.2 +7 -4 parrot/build_interp_starter.pl
Index: build_interp_starter.pl
===================================================================
RCS file: /home/perlcvs/parrot/build_interp_starter.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- build_interp_starter.pl 2001/09/06 02:35:33 1.1
+++ build_interp_starter.pl 2001/09/10 21:26:09 1.2
@@ -1,5 +1,5 @@
-#! perl -w
-#
+# !/usr/bin/perl -w
+use strict;
open INTERP, "> interp_guts.h" or die "Can't open interp_guts.h, $!/$^E";
@@ -18,13 +18,16 @@
#define BUILD_TABLE(x) do { \\
CONST
+my $count = 1;
while (<OPCODES>) {
chomp;
s/#.*$//;
s/^\s+//;
next unless $_;
- ($num, $name) = split /\s+/;
+ my($name) = split /\s+/;
+ my $num = $count;
+ $num = 0 if $name eq 'end';
print INTERP "\tx[$num] = $name; \\\n";
- $num++;
+ $count++ unless $name eq 'end';
}
print INTERP "} while (0);\n";
1.2 +30 -10 parrot/disassemble.pl
Index: disassemble.pl
===================================================================
RCS file: /home/perlcvs/parrot/disassemble.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- disassemble.pl 2001/08/29 12:07:02 1.1
+++ disassemble.pl 2001/09/10 21:26:09 1.2
@@ -1,10 +1,13 @@
-#! perl -w
+#! /usr/bin/perl -w
#
# Disassemble.pl
#
# Turn a parrot bytecode file into text
-my %opcodes;
+use strict;
+
+my(%opcodes, @opcodes);
+
my %unpack_type;
%unpack_type = (i => 'l',
n => 'd',
@@ -13,15 +16,22 @@
n => 8,
);
+open GUTS, "interp_guts.h";
+my $opcode;
+while (<GUTS>) {
+ next unless /\tx\[(\d+)\] = ([a-z_]+);/;
+ $opcodes{$2}{CODE} = $1;
+}
+
open OPCODES, "<opcode_table" or die "Can't get opcode table, $!/$^E";
while (<OPCODES>) {
next if /^\s*#/;
chomp;
- my ($code, $name, $args, @types) = split /\s+/, $_;
- $opcodes{$name} = {CODE => $code,
- ARGS => $args,
- TYPES => [@types]
- };
+ my ($name, $args, @types) = split /\s+/, $_;
+ next unless defined $name;
+ $opcodes{$name}{ARGS} = $args;
+ $opcodes{$name}{TYPES} = [@types];
+ my $code = $opcodes{$name}{CODE};
$opcodes[$code] = {NAME => $name,
ARGS => $args,
TYPES => [@types]
@@ -29,14 +39,24 @@
}
$/ = \4;
+
+my $magic = unpack('l', <>);
+die "Not parrot bytecode!\n" if ($magic != 0x013155a1);
+
+my $fixups = unpack('l', <>);
+# No fixups yet
+
+my $constants = unpack('l', <>);
+# Skip for now
+
while (<>) {
- $code = unpack 'l', $_;
- $args = $opcodes[$code]{ARGS};
+ my $code = unpack 'l', $_;
+ my $args = $opcodes[$code]{ARGS};
print $opcodes[$code]{NAME};
if ($args) {
foreach (1..$args) {
local $/ = \$unpack_size{$opcodes[$code]{TYPES}[$_-1]};
- $data = <>;
+ my $data = <> || die("EOF when expecting argument!\n");
print " ", unpack $unpack_type{$opcodes[$code]{TYPES}[$_-1]}, $data;
}
}
1.3 +1 -1 parrot/make_op_header.pl
Index: make_op_header.pl
===================================================================
RCS file: /home/perlcvs/parrot/make_op_header.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- make_op_header.pl 2001/09/03 16:38:29 1.2
+++ make_op_header.pl 2001/09/10 21:26:09 1.3
@@ -5,7 +5,7 @@
while (<>) {
next if /^\s*#/ or /^\s*$/;
chomp;
- (undef, $name, undef) = split /\t/, $_;
+ ($name, undef) = split /\t/, $_;
print "IV *$name(IV *, struct Perl_Interp *);\n";
}
1.6 +60 -49 parrot/opcode_table
Index: opcode_table
===================================================================
RCS file: /home/perlcvs/parrot/opcode_table,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- opcode_table 2001/09/10 15:48:36 1.5
+++ opcode_table 2001/09/10 21:26:09 1.6
@@ -1,82 +1,93 @@
# opcode function table
#
# format is:
-# number name args arg_types
+# name args arg_types
#
+# Opcode number is determined at build time
+#
# All fields should be whitespace separated
#
# The arg_types are the types to be packed (integer, number, whatever)
# 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.
+# This must be opcode zero
+
+end 0
+
# Integer ops
-6 set_i_ic 2 i i
-1 add_i 3 i i i
-7 sub_i 3 i i i
-8 mul_i 3 i i i
-9 div_i 3 i i i
-11 inc_i 1 i
-12 inc_i_ic 2 i i
-13 dec_i 1 i
-14 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
-16 set_n_nc 2 i n
-17 add_n 3 i i i
-18 sub_n 3 i i i
-19 mul_n 3 i i i
-20 div_n 3 i i i
-25 inc_n 1 i
-26 inc_n_nc 2 i n
-27 dec_n 1 i
-28 dec_n_nc 2 i n
+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
# String ops
-31 set_s_sc 2 i i
-32 print_s 1 i
-33 length_s_i 2 i i
-34 chopn_s_ic 2 i i
+set_s_sc 2 i i
+print_s 1 i
+length_s_i 2 i i
+chopn_s_ic 2 i i
# Comparators
-2 eq_i_ic 4 i i i i
-21 eq_n_ic 4 i i i i
+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
# Flow control
-0 end 0
-15 jump_i 1 i
-5 branch_ic 1 i
-10 if_i_ic 3 i i i
-24 if_n_ic 3 i i i
+jump_i 1 i
+branch_ic 1 i
+if_i_ic 3 i i i
+if_n_ic 3 i i i
# Convertors
-29 iton_n_i 2 i i
-30 ntoi_i_n 2 i i
+iton_n_i 2 i i
+ntoi_i_n 2 i i
# Miscellaneous and debugging ops
-3 time_i 1 i
-4 print_i 1 i
-22 time_n 1 i
-23 print_n 1 i
-47 noop 0
+time_i 1 i
+print_i 1 i
+time_n 1 i
+print_n 1 i
+noop 0
# Register ops
-35 push_i 0
-36 push_s 0
-37 push_n 0
-38 push_p 0
-39 pop_i 0
-40 pop_s 0
-41 pop_n 0
-42 pop_p 0
-43 clear_i 0
-44 clear_s 0
-45 clear_n 0
-46 clear_p 0
+push_i 0
+push_s 0
+push_n 0
+push_p 0
+pop_i 0
+pop_s 0
+pop_n 0
+pop_p 0
+clear_i 0
+clear_s 0
+clear_n 0
+clear_p 0
1.3 +14 -2 parrot/process_opfunc.pl
Index: process_opfunc.pl
===================================================================
RCS file: /home/perlcvs/parrot/process_opfunc.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- process_opfunc.pl 2001/09/06 21:07:44 1.2
+++ process_opfunc.pl 2001/09/10 21:26:09 1.3
@@ -29,16 +29,26 @@
# X. (Parameter 0 is the opcode number) Types for each, and the size
# of the return offset, are taken from the opcode_table file
+use strict;
+
+my %opcode;
+
+open GUTS, "interp_guts.h";
+my $opcode;
+while (<GUTS>) {
+ next unless /\tx\[(\d+)\] = ([a-z_]+);/;
+ $opcode{$2}{OPNUM} = $1;
+}
+
open OPCODE, "opcode_table" or die "Can't open opcode_table, $!/$^E";
while (<OPCODE>) {
s/#.*//;
s/^\s+//;
chomp;
next unless $_;
- my ($num, $name, $params, @params) = split /\s+/;
+ my ($name, $params, @params) = split /\s+/;
$opcode{$name}{PARAM_COUNT} = $params;
$opcode{$name}{PARAM_ARRAY} = \@params;
- $opcode{$name}{OPNUM} = $num;
my $num_i = () = grep {/i/} @params;
my $num_n = () = grep {/n/} @params;
@@ -62,7 +72,9 @@
}
open OUTPUT, ">$file" or die "Can't open $file, $!/$^E";
+my($name, $footer);
while (<INPUT>) {
+
if (/^AUTO_OP/) {
($name, $footer) = emit_auto_header($_);
next;
