On Thu, Sep 20, 2001 at 12:15:37AM -0400, Michael Fischer wrote:
> please see attached process_switch.pl
> notes inside.
I've been working on the same thing. For comparison, I'm attaching
generate.pl, my replacement for build_interp_starter.pl,
process_opfuncs.pl, and make_op_header.pl. (I agree that the
various generators should share more code; my solution was to unify
them.)
generate.pl takes a list of opcode definition files on the command
line. It writes the interp_guts.h and op.h headers, as well as .c
files for all opcode definition files. It takes an optional -d
argument specifying the type of dispatch to use: valid values are
"function" and "switch".
There are some rough spots, but it appears to work overall.
> Made it work, Gibbs has seen patch, but we wanted to
> defer to Dan/Simon because op.h has the knack of
> redefining every op as Parrot_op_foo. :-(
This is necessary to avoid namespace pollution. In particular, the
"end" op will cause everything to go pear-shaped on FreeBSD without
mangling. (Personally, I'd rather we didn't use the defines at all,
and just referred to the functions as Parrot_op_foo; after all, only
generated code should ever call these functions.)
> Gibbs and I thought that the build_interp_starter
> and process_opfuncs perl files ought to be able
> to share more code, particularly since this submission
> is practically a copy of process_opfuncs, and the
> enum is trivially done inside build_interp_starter.
> However, we have not come to any decision on _where_
> the shared code should go. Suggestions solicited.
Whether my generate.pl is used or not, I think that unifying
generation into a single program is the right approach.
> One bug: I can't quite deal gracefully
> with the #includes, I just nuke 'em and write them back,
> but the multi-line C-comment block at the top of
> basic_opcodes.ops is a pain. Eliminating it clobbers
> everything with a STRING *....
I'm not at all certain what to do with things outside the opcodes
themselves. The .ops => .c conversion was clearly originally
concieved as translating one file into another. In order to dispatch
ops via a switch, you need to pull out only the function contents;
this makes the .ops file into a definition of function code only...the
remainder of the file gets tossed by the wayside.
- Damien
#!/usr/bin/perl -w
use strict;
use Parrot::Opcode;
use Getopt::Std;
use Symbol;
####################
# Arguments.
sub usage {
print STDERR "Usage: $0 -d <function | switch> [<file> ...]\n";
exit 1;
}
my %opts = (d => "function");
getopts("d:", \%opts) or usage;
if ($opts{d} ne "function" && $opts{d} ne "switch") {
print STDERR "Supported dispatch modes: function, switch.\n";
exit 1;
}
####################
# Opcodes.
my $opcode_fingerprint = Parrot::Opcode::fingerprint();
my %opcodes = Parrot::Opcode::read_ops();
my @opcodes;
for my $name (keys %opcodes) {
my $op = $opcodes{$name};
push @opcodes, $op;
$op->{NAME} = $name;
}
@opcodes = sort { $a->{CODE} <=> $b->{CODE} } @opcodes;
my %files;
for my $f (@ARGV) {
$files{$f} = [ read_ops($f) ];
}
####################
# quoted() is used to simplify generation. The leading regex /\s*#/ is
# stripped from text, to allow here-docs to be set off from the surrounding
# Perl code. Lines beginning with /\s*\#\*/ are printed once for every
# opcode. Text surrounded in curly braces, like {THIS}, is replaced with
# the value of the appropriate field in the opcode definition.
sub quoted {
my $s = "";
for (split /\n/, $_[0]) {
if (s/^\s*\#\*//) {
for my $op (@opcodes) {
my $t = $_; $t =~ s/{(\w+)}/$op->{$1}/ge;
$s .= "$t\n";
}
}
elsif (s/^\s*\# ?//) {
$s .= "$_\n";
}
}
$s;
}
####################
# op.h
open OP_H, "> include/parrot/op.h"
or die "include/parrot/op.h: $!\n";
print OP_H quoted(<<END)
# /*
# * op.h
# * Opcode header.
# * This file is autogenerated by generate.pl -- DO NOT EDIT.
# */
#
# #if !defined(PARROT_OP_H_GUARD)
# #define PARROT_OP_H_GUARD
#
# typedef IV OP;
#
# #define DEFAULT_OPCODE_TABLE NULL
#
END
;
if ($opts{d} eq "function") {
print OP_H quoted(<<END)
#*#define {NAME} Parrot_op_{NAME}
#
#*opcode_t *{NAME}(opcode_t *, struct Parrot_Interp *);
END
;
}
print OP_H quoted(<<END)
#
# #endif
END
;
####################
# interp_guts.h
open INTERP, "> include/parrot/interp_guts.h"
or die "include/parrot/interp_guts.h: $!\n";
print INTERP quoted(<<END)
# /*
# * interp_guts.h
# *
# * This file is autogenerated by generate.pl -- DO NOT EDIT.
# */
#
# #define BUILD_TABLE(x) do { \\
END
;
for my $op (@opcodes) {
if ($opts{d} eq "function") {
print INTERP "\tx[$op->{CODE}] = (void*)$op->{NAME}; \\\n";
} else {
print INTERP "\tx[$op->{CODE}] = NULL; \\\n";
}
}
print INTERP quoted(<<END)
# } while (0);
#
# #define BUILD_NAME_TABLE(x) do { \\
#* x[{CODE}] = \"{NAME}\"; \\
# } while (0);
#
# #define BUILD_ARG_TABLE(x) do { \\
#* x[{CODE}] = {ARGS}; \\
# } while(0);
#
END
;
if ($opts{d} eq "function") {
print INTERP quoted(<<END)
# #define DO_OP(code, temp, func, interp) do { \\
# temp = (void *)interp->opcode_funcs; \\
# func = (opcode_t* (*)())temp[code->i]; \\
# code = (func)(code, interp); \\
# } while(0);
END
;
} elsif ($opts{d} eq "switch") {
print INTERP "#define DO_OP(cur_opcode, temp, func, interp) do { \\\n";
print INTERP " switch (cur_opcode->i) { \\\n";
for my $op (@opcodes) {
if (defined $op->{IMPL_BODY}) {
my $body = $op->{IMPL_BODY};
$body =~ s/RETVAL/return_offset/g;
$body =~ s/RETURN\(0\);/;/g;
$body =~ s/RETURN\((.*)\)/cur_opcode = cur_opcode + $1; break/g;
print INTERP " case $op->{CODE}: { \\\n";
for (split /\n/, $body) {
print INTERP "$_ \\\n";
}
print INTERP " cur_opcode += $op->{IMPL_RETURN_ADDR}; } \\\n";
print INTERP " break; \\\n";
}
}
print INTERP " default: \\\n";
print INTERP " exit(1); /* XXX: Better error trapping */ \\\n";
print INTERP " } } while(0)\n";
}
print INTERP quoted(<<END)
#
# #define OPCODE_FINGERPRINT "$opcode_fingerprint"
END
;
close INTERP;
####################
# Generate opcode files.
for my $f (@ARGV) {
my $output = $f;
$output =~ s/(\.ops)?$/.c/;
open OUTPUT, "> $output" or die "$output: $!\n";
print OUTPUT quoted(<<END)
# /*
# * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
# * This file is automatically generated from $f.
# * Edit it instead.
# */
#
# #include "parrot/parrot.h"
# #include <math.h>
#
END
;
if ($opts{d} ne "function") {
close OUTPUT;
next;
}
for my $name (@{$files{$f}}) {
my $op = $opcodes{$name};
my $body = $op->{IMPL_BODY};
$body =~ s/RETVAL/return_offset/g;
$body =~ s/RETURN\(0\);/return 0;/g;
$body =~ s/RETURN\((.*)\)/return cur_opcode + $1/g;
print OUTPUT "#line $op->{IMPL_LINE} \"$op->{IMPL_FILE}\"\n";
print OUTPUT ("opcode_t *$op->{FUNC}(".
"opcode_t cur_opcode[], ".
"struct Parrot_Interp *interpreter".
") {\n");
print OUTPUT $body;
print OUTPUT " return cur_opcode + $op->{IMPL_RETURN_ADDR};\n}\n\n";
}
close OUTPUT;
}
####################
# Read opcode function definitions.
#
# Opcode functions are in the format:
#
# AUTO_OP opname {
#
# ... body of function ...
#
# }
#
# Where the closing brace is on its own line. Alternately, for opcode
# functions that manage their own return values:
#
# MANUAL_OP opname {
#
# ... body of function ...
#
# RETVAL = x;
#
# }
#
# There may be more than one RETVAL
#
# The functions have the magic variables Pnnn for parameters 1 through
# X. (Parameter 0 is the opcode number) Types for each, and the size
# of the return offset, are taken from the opcode_table file
sub read_ops {
my($file) = @_;
open INPUT, $file or die "$file: $!\n";
my @ops;
my($name, $body, $footer, @param_sub);
while (<INPUT>) {
if (/^AUTO_OP/) {
$body = "";
($name, $footer) = auto_code($_);
}
if (/^MANUAL_OP/) {
$body = " IV return_offset = 1;\n";
($name, $footer) = manual_code($_);
}
if (/^(AUTO|MANUAL)_OP/) {
push @ops, $name;
if (defined $opcodes{$name}{IMPL_FILE}) {
print STDERR "Warning: $name implemented multiple times:\n";
print STDERR " $opcodes{$name}{IMPL_FILE}, ",
"line $opcodes{$name}{IMPL_LINE}\n";
print STDERR " $file, line $.\n";
}
$opcodes{$name}{IMPL_FILE} = $file;
$opcodes{$name}{IMPL_LINE} = $.;
my $count = 1;
@param_sub = ("",
map {if ($_ eq "n") {
my $temp = '*(NV *)&cur_opcode['.$count.']';
$count += 2;
$temp;
} else {
"cur_opcode[" . $count++ . "].i"
}
} @{$opcodes{$name}{TYPES}});
next;
}
s/\bP(\d+)\b/$param_sub[$1]/g;
if (/^\}/) {
$opcodes{$name}{IMPL_BODY} = $body;
$opcodes{$name}{IMPL_RETURN_ADDR} = $footer;
$name = undef;
$body = undef;
$footer = undef;
@param_sub = ();
}
if (defined $body) {
$body .= $_;
}
}
close INPUT;
return @ops;
}
my %psize;
BEGIN {
%psize = (i => 1,
n => 2,
I => 1,
N => 1,
D => 1,
S => 1,
s => 1,
);
}
sub auto_code {
my($line) = @_;
my($name) = $line =~ /^AUTO_OP\s+(\w+)/;
die "$name: unknown opcode\n" unless $opcodes{$name};
my $psize = 0;
foreach (@{$opcodes{$name}{TYPES}}) {
$psize+=$psize{$_};
}
my $return_offset = $psize + 1;
return($name, $return_offset);
}
sub manual_code {
my($line) = @_;
my($name) = $line =~ /^MANUAL_OP\s+(\w+)/;
die "$name: unknown opcode\n" unless $opcodes{$name};
return($name, "return_offset");
}
