Here's an updated version of my original patch, to account for recent
changes in CVS. As before, this includes opcode-munging to let Parrot
run on FreeBSD.
- Damien
diff -u --new-file -r parrot.orig/Parrot/Opcode.pm parrot/Parrot/Opcode.pm
--- parrot.orig/Parrot/Opcode.pm Wed Dec 31 16:00:00 1969
+++ parrot/Parrot/Opcode.pm Mon Sep 10 23:52:35 2001
@@ -0,0 +1,86 @@
+package Parrot::Opcode;
+
+use strict;
+use Symbol;
+
+sub read_ops {
+ my $file = @_ ? shift : "opcode_table";
+
+ my $fh = gensym;
+ open $fh, $file or die "$file: $!\n";
+
+ my %opcode;
+ my $count = 1;
+ while (<$fh>) {
+ s/#.*//;
+ s/^\s+//;
+ chomp;
+ next unless $_;
+
+ my($name, @params) = split /\s+/;
+ if (@params && $params[0] =~ /^\d+$/) {
+ my $count = shift @params;
+ die "$file, line $.: opcode $name parameters don't match count\n"
+ if ($count != @params);
+ }
+
+ warn "$file, line $.: opcode $name redefined\n" if $opcode{$name};
+
+ $opcode{$name}{ARGS} = @params;
+ $opcode{$name}{TYPES} = \@params;
+ $opcode{$name}{CODE} = ($name eq "end") ? 0 : $count++;
+ $opcode{$name}{FUNC} = "Parrot_op_$name";
+
+ my $num_i = () = grep {/i/} @params;
+ my $num_n = () = grep {/n/} @params;
+ $opcode{$name}{RETURN_OFFSET} = 1 + $num_i + $num_n * 2;
+ }
+
+ return %opcode;
+}
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+Parrot::Opcode - Read opcode definitions
+
+=head1 SYNOPSIS
+
+ use Parrot::Opcode;
+
+ %opcodes = Parrot::Opcode::read_ops();
+
+=head1 DESCRIPTION
+
+The read_ops() function parses the Parrot opcode_table file, and
+returns the contents as a hash. The hash key is the opcode name;
+values are hashrefs containing the following fields:
+
+=over
+
+=item CODE
+
+The opcode number.
+
+=item ARGS
+
+The opcode argument count.
+
+=item TYPES
+
+The opcode argument types, as an arrayref.
+
+=item FUNC
+
+The name of the C function implementing this op.
+
+=back
+
+read_ops() takes an optional argument: the file to read the opcode table
+from.
+
+=cut
diff -u --new-file -r parrot.orig/assemble.pl parrot/assemble.pl
--- parrot.orig/assemble.pl Thu Sep 13 20:45:05 2001
+++ parrot/assemble.pl Thu Sep 13 20:33:36 2001
@@ -5,6 +5,7 @@
# Brian Wheeler ([EMAIL PROTECTED])
use strict;
+use Parrot::Opcode;
my $opt_c;
if (@ARGV and $ARGV[0] eq "-c") {
@@ -25,32 +26,10 @@
foreach (keys(%real_type)) {
$sizeof{$_}=length(pack($pack_type{$real_type{$_}},0));
}
-
-# get opcodes from guts.
-open GUTS, "interp_guts.h";
-my %opcodes;
-while (<GUTS>) {
- next unless /\tx\[(\d+)\] = ([a-z_]+);/;
- $opcodes{$2}{CODE} = $1;
-}
-close GUTS;
-# get opcodes and their arg lists
-open OPCODES, "<opcode_table" or die "Can't get opcode table, $!/$^E";
-while (<OPCODES>) {
- next if /^\s*#/;
- chomp;
- 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];
-}
-close OPCODES;
+# get opcodes
+my %opcodes = Parrot::Opcode::read_ops();
# read source and assemble
@@ -134,8 +113,8 @@
$pc+=4;
foreach (0..$#args) {
- my($rtype)=$opcodes{$opcode}{RTYPES}[$_];
- my($type)=$opcodes{$opcode}{TYPES}[$_];
+ my($rtype)=$opcodes{$opcode}{TYPES}[$_];
+ my($type)=$real_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;
diff -u --new-file -r parrot.orig/build_interp_starter.pl
parrot/build_interp_starter.pl
--- parrot.orig/build_interp_starter.pl Thu Sep 13 20:45:05 2001
+++ parrot/build_interp_starter.pl Thu Sep 13 20:36:14 2001
@@ -1,10 +1,9 @@
# !/usr/bin/perl -w
use strict;
+use Parrot::Opcode;
open INTERP, "> interp_guts.h" or die "Can't open interp_guts.h, $!/$^E";
-open OPCODES, "opcode_table" or die "Can't open opcode_table, $!/$^E";
-
print INTERP <<CONST;
/*
*
@@ -18,17 +17,9 @@
#define BUILD_TABLE(x) do { \\
CONST
-my $count = 1;
-while (<OPCODES>) {
- chomp;
- s/#.*$//;
- s/^\s+//;
- next unless $_;
- my($name) = split /\s+/;
- my $num = $count;
- $num = 0 if $name eq 'end';
- print INTERP "\tx[$num] = $name; \\\n";
- $count++ unless $name eq 'end';
+my %opcodes = Parrot::Opcode::read_ops();
+for my $name (sort {$opcodes{$a}{CODE} <=> $opcodes{$b}{CODE}} keys %opcodes) {
+ print INTERP "\tx[$opcodes{$name}{CODE}] = $opcodes{$name}{FUNC}; \\\n";
}
print INTERP "} while (0);\n";
diff -u --new-file -r parrot.orig/disassemble.pl parrot/disassemble.pl
--- parrot.orig/disassemble.pl Thu Sep 13 20:45:05 2001
+++ parrot/disassemble.pl Thu Sep 13 20:37:47 2001
@@ -5,6 +5,7 @@
# Turn a parrot bytecode file into text
use strict;
+use Parrot::Opcode;
my(%opcodes, @opcodes);
@@ -25,28 +26,10 @@
s => 4,
);
-open GUTS, "interp_guts.h";
-my $opcode;
-while (<GUTS>) {
- next unless /\tx\[(\d+)\] = ([a-z0-9_]+);/;
- $opcodes{$2}{CODE} = $1;
-}
-
-open OPCODES, "<opcode_table" or die "Can't get opcode table, $!/$^E";
-while (<OPCODES>) {
- next if /^\s*#/;
- s/^\s+//;
- chomp;
- next unless $_;
- 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]
- }
+%opcodes = Parrot::Opcode::read_ops();
+for my $name (keys %opcodes) {
+ $opcodes[$opcodes{$name}{CODE}] = { NAME => $name,
+ %{$opcodes{$name}} };
}
$/ = \4;
diff -u --new-file -r parrot.orig/make_op_header.pl parrot/make_op_header.pl
--- parrot.orig/make_op_header.pl Thu Sep 13 20:45:06 2001
+++ parrot/make_op_header.pl Thu Sep 13 20:38:51 2001
@@ -2,11 +2,12 @@
#
# rip through opcode_table and spit out a chunk of C header for the
# functions in it
-while (<>) {
- next if /^\s*#/ or /^\s*$/;
- chomp;
- ($name, undef) = split /\s+/, $_;
- print "IV *$name(IV *, struct Perl_Interp *);\n";
+use strict;
+use Parrot::Opcode;
+
+my %opcodes = Parrot::Opcode::read_ops();
+for my $name (sort {$opcodes{$a}{CODE} <=> $opcodes{$b}{CODE}} keys %opcodes) {
+ print "IV *$opcodes{$name}{FUNC}(IV *, struct Perl_Interp *);\n";
}
BEGIN {
diff -u --new-file -r parrot.orig/process_opfunc.pl parrot/process_opfunc.pl
--- parrot.orig/process_opfunc.pl Thu Sep 13 20:45:06 2001
+++ parrot/process_opfunc.pl Thu Sep 13 20:47:57 2001
@@ -30,6 +30,9 @@
# of the return offset, are taken from the opcode_table file
use strict;
+use Parrot::Opcode;
+
+my %opcodes = Parrot::Opcode::read_ops();
my %opcode;
@@ -87,16 +90,28 @@
}
open OUTPUT, ">$file" or die "Can't open $file, $!/$^E";
-my($name, $footer);
+my($name, $footer, @param_sub);
while (<INPUT>) {
if (/^AUTO_OP/) {
($name, $footer) = emit_auto_header($_);
- next;
}
if (/^MANUAL_OP/) {
($name, $footer) = emit_manual_header($_);
+ }
+
+ if (/^(AUTO|MANUAL)_OP/) {
+ my $count = 1;
+ @param_sub = ("",
+ map {if ($_ eq "n") {
+ my $temp = '*(NV *)&cur_opcode[' . $count . ']';
+ $count += 2;
+ $temp;
+ } else {
+ "cur_opcode[" . $count++ . "]"
+ }
+ } @{$opcodes{$name}{TYPES}});
next;
}
@@ -106,7 +121,7 @@
s/RETURN\((.*)\)/return cur_opcode + $1/;
- s/\bP(\d+)\b/$opcode{$name}{PARAMETER_SUB}[$1]/g;
+ s/\bP(\d+)\b/$param_sub[$1]/g;
if (/^}/) {
print OUTPUT $footer, "\n";
@@ -119,17 +134,26 @@
sub emit_auto_header {
my $line = shift;
my ($name) = $line =~ /AUTO_OP\s+(\w+)/;
+
+ my $psize=0;
+ foreach (@{$opcodes{$name}{TYPES}}) {
+ $psize+=$psize{$_};
+ }
+ my $return_offset = $psize + 1;
+
+ $opcode{$name}{RETURN_OFFSET} = 1 + $psize;
- print OUTPUT "IV *$name(IV cur_opcode[], struct Perl_Interp *interpreter) {\n";
- return($name, " return cur_opcode + "
- . $opcode{$name}{RETURN_OFFSET}. ";\n}\n");
+ print OUTPUT ("IV *$opcodes{$name}{FUNC}".
+ "(IV cur_opcode[], struct Perl_Interp *interpreter) {\n");
+ return($name, " return cur_opcode + " . $return_offset . ";\n}\n");
}
sub emit_manual_header {
my $line = shift;
my ($name) = $line =~ /MANUAL_OP\s+(\w+)/;
- print OUTPUT "IV *$name(IV cur_opcode[], struct Perl_Interp *interpreter) {\n";
+ print OUTPUT ("IV *$opcodes{$name}{FUNC}".
+ "(IV cur_opcode[], struct Perl_Interp *interpreter) {\n");
print OUTPUT " IV return_offset = 1;\n";
return($name, " return cur_opcode + return_offset;\n}\n");
}
