Dan --
> Here's something for someone looking to do something interesting while the
> code freeze is on.
>
> Write yourself a program that takes a .pasm file and, rather than spitting
> out bytecode, spits out the bodies of the opcode functions with the
> appropriate replacements done on the parameters. The output should be
> suitable for stuffing into the guts of test_main.c in the place of the call
> to the runops loop.
My first cut is pretty sloppy, but it does generate this C file, which
compiles, but I don't have the time to figure out how to get it all the
stuff it needs to link to. If someones gets it running, I'd like to see
how many Mops they get vs. regular.
This is generated from t/test.pbc (not t/test.pasm).
The code is a total hack job, but you are welcome to look at it
(compile.pl and Parrot/OpFunc.pm).
Enjoy,
-- Gregor
_____________________________________________________________________
/ perl -e 'srand(-2091643526); print chr rand 90 for (0..4)' \
Gregor N. Purdy [EMAIL PROTECTED]
Focus Research, Inc. http://www.focusresearch.com/
8080 Beckett Center Drive #203 513-860-3570 vox
West Chester, OH 45069 513-860-3579 fax
\_____________________________________________________________________/
#include "parrot/parrot.h"
#include <math.h>
int
main(int argc, char **argv) {
int i;
struct Parrot_Interp *interpreter;
init_world();
interpreter = make_interpreter();
/* time_i I1 */
PC_1: { /* time_i */
INT_REG(1) = time(NULL);
goto PC_3;
}
/* set_i_ic I2, 0 */
PC_3: { /* set_i_ic */
INT_REG(2) = 0;
goto PC_6;
}
/* set_i_ic I3, 1 */
PC_6: { /* set_i_ic */
INT_REG(3) = 1;
goto PC_9;
}
/* set_i_ic I4, 100000000 */
PC_9: { /* set_i_ic */
INT_REG(4) = 100000000;
goto PC_12;
}
/* set_s_sc S0, [String 1] */
PC_12: { /* set_s_sc */
STR_REG(0) = Parrot_string_constants[1];
goto PC_15;
}
/* print_s S0 */
PC_15: { /* print_s */
STRING *s = STR_REG(0);
printf("%.*s",(int)string_length(s),(char *) s->bufstart);
goto PC_17;
}
/* print_i I4 */
PC_17: { /* print_i */
printf("%li", INT_REG(4));
goto PC_19;
}
/* eq_i_ic I2, I4, 10 */
PC_19: { /* eq_i_ic */
if (INT_REG(2) == INT_REG(4)) {
goto PC_29;
}
goto PC_23;
}
/* add_i I2, I2, I3 */
PC_23: { /* add_i */
INT_REG(2) = INT_REG(2) +
INT_REG(3);
goto PC_27;
}
/* branch_ic -8 */
PC_27: { /* branch_ic */
goto PC_19;
goto PC_29;
}
/* time_i I5 */
PC_29: { /* time_i */
INT_REG(5) = time(NULL);
goto PC_31;
}
/* set_s_sc S0, [String 2] */
PC_31: { /* set_s_sc */
STR_REG(0) = Parrot_string_constants[2];
goto PC_34;
}
/* print_s S0 */
PC_34: { /* print_s */
STRING *s = STR_REG(0);
printf("%.*s",(int)string_length(s),(char *) s->bufstart);
goto PC_36;
}
/* print_i I1 */
PC_36: { /* print_i */
printf("%li", INT_REG(1));
goto PC_38;
}
/* set_s_sc S0, [String 3] */
PC_38: { /* set_s_sc */
STR_REG(0) = Parrot_string_constants[3];
goto PC_41;
}
/* print_s S0 */
PC_41: { /* print_s */
STRING *s = STR_REG(0);
printf("%.*s",(int)string_length(s),(char *) s->bufstart);
goto PC_43;
}
/* print_i I5 */
PC_43: { /* print_i */
printf("%li", INT_REG(5));
goto PC_45;
}
/* set_s_sc S0, [String 4] */
PC_45: { /* set_s_sc */
STR_REG(0) = Parrot_string_constants[4];
goto PC_48;
}
/* print_s S0 */
PC_48: { /* print_s */
STRING *s = STR_REG(0);
printf("%.*s",(int)string_length(s),(char *) s->bufstart);
goto PC_50;
}
/* print_i I2 */
PC_50: { /* print_i */
printf("%li", INT_REG(2));
goto PC_52;
}
/* set_s_sc S0, [String 5] */
PC_52: { /* set_s_sc */
STR_REG(0) = Parrot_string_constants[5];
goto PC_55;
}
/* print_s S0 */
PC_55: { /* print_s */
STRING *s = STR_REG(0);
printf("%.*s",(int)string_length(s),(char *) s->bufstart);
goto PC_57;
}
/* sub_i I2, I5, I1 */
PC_57: { /* sub_i */
INT_REG(2) = INT_REG(5) -
INT_REG(1);
goto PC_61;
}
/* print_i I2 */
PC_61: { /* print_i */
printf("%li", INT_REG(2));
goto PC_63;
}
/* set_i_ic I1, 3 */
PC_63: { /* set_i_ic */
INT_REG(1) = 3;
goto PC_66;
}
/* mul_i I4, I4, I1 */
PC_66: { /* mul_i */
INT_REG(4) = INT_REG(4) *
INT_REG(1);
goto PC_70;
}
/* iton_n_i N1, I4 */
PC_70: { /* iton_n_i */
NUM_REG(1) = INT_REG(4);
goto PC_73;
}
/* iton_n_i N2, I2 */
PC_73: { /* iton_n_i */
NUM_REG(2) = INT_REG(2);
goto PC_76;
}
/* set_s_sc S0, [String 6] */
PC_76: { /* set_s_sc */
STR_REG(0) = Parrot_string_constants[6];
goto PC_79;
}
/* print_s S0 */
PC_79: { /* print_s */
STRING *s = STR_REG(0);
printf("%.*s",(int)string_length(s),(char *) s->bufstart);
goto PC_81;
}
/* print_i I4 */
PC_81: { /* print_i */
printf("%li", INT_REG(4));
goto PC_83;
}
/* set_s_sc S0, [String 7] */
PC_83: { /* set_s_sc */
STR_REG(0) = Parrot_string_constants[7];
goto PC_86;
}
/* print_s S0 */
PC_86: { /* print_s */
STRING *s = STR_REG(0);
printf("%.*s",(int)string_length(s),(char *) s->bufstart);
goto PC_88;
}
/* print_n N1 */
PC_88: { /* print_n */
printf("%f", NUM_REG(1));
goto PC_90;
}
/* set_s_sc S0, [String 5] */
PC_90: { /* set_s_sc */
STR_REG(0) = Parrot_string_constants[5];
goto PC_93;
}
/* print_s S0 */
PC_93: { /* print_s */
STRING *s = STR_REG(0);
printf("%.*s",(int)string_length(s),(char *) s->bufstart);
goto PC_95;
}
/* print_i I2 */
PC_95: { /* print_i */
printf("%li", INT_REG(2));
goto PC_97;
}
/* set_s_sc S0, [String 5] */
PC_97: { /* set_s_sc */
STR_REG(0) = Parrot_string_constants[5];
goto PC_100;
}
/* print_s S0 */
PC_100: { /* print_s */
STRING *s = STR_REG(0);
printf("%.*s",(int)string_length(s),(char *) s->bufstart);
goto PC_102;
}
/* print_n N2 */
PC_102: { /* print_n */
printf("%f", NUM_REG(2));
goto PC_104;
}
/* div_n N1, N1, N2 */
PC_104: { /* div_n */
NUM_REG(1) = NUM_REG(1) /
NUM_REG(2);
goto PC_108;
}
/* set_s_sc S0, [String 8] */
PC_108: { /* set_s_sc */
STR_REG(0) = Parrot_string_constants[8];
goto PC_111;
}
/* print_s S0 */
PC_111: { /* print_s */
STRING *s = STR_REG(0);
printf("%.*s",(int)string_length(s),(char *) s->bufstart);
goto PC_113;
}
/* print_n N1 */
PC_113: { /* print_n */
printf("%f", NUM_REG(1));
goto PC_115;
}
/* set_s_sc S0, [String 9] */
PC_115: { /* set_s_sc */
STR_REG(0) = Parrot_string_constants[9];
goto PC_118;
}
/* print_s S0 */
PC_118: { /* print_s */
STRING *s = STR_REG(0);
printf("%.*s",(int)string_length(s),(char *) s->bufstart);
goto PC_120;
}
/* end */
PC_120: { /* end */
goto PC_0;
goto PC_121;
}
PC_121:
PC_0: {
exit(0);
}
return 0;
}
#! perl -w
#
# OpFunc.pm
#
# Take a file of opcode functions and create real C code for them
#
# 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 ...
#
# RETURN(x);
#
# }
#
# There may be more than one RETURN
#
# 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
#
use strict;
package Parrot::OpFunc;
use Parrot::Opcode;
use Parrot::Config;
BEGIN {
use Exporter;
use vars qw(%op_body @EXPORT @ISA);
@ISA = qw(Exporter);
@EXPORT = qw(%op_body);
};
my $current_name = '';
my $current_body = '';
my %opcodes = Parrot::Opcode::read_ops();
my %opcode;
my $opcode;
my %psize = (i => 1,
n => $PConfig{nvsize}/$PConfig{ivsize},
I => 1,
N => 1,
D => 1,
S => 1,
s => 1,
);
#
# init()
#
sub init
{
my ($class, $file) = @_;
die "Parrot::OpFunc::init(): No file specified!\n" unless defined $file;
open GUTS, "include/parrot/interp_guts.h"
or die "Could not open include/parrot/interp_guts.h";
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 ($name, $params, @params) = split /\s+/;
$opcode{$name}{PARAM_COUNT} = $params;
$opcode{$name}{PARAM_ARRAY} = \@params;
my $psize=0;
foreach (@params) {
$psize+=$psize{$_};
}
$opcode{$name}{RETURN_OFFSET} = 1 + $psize;
my $count = 1;
$opcode{$name}{PARAMETER_SUB} = ["",
map {if ($_ eq "n") {
my $temp = '*(NV *)(&cur_opcode[' . $count .
'])';
$count += 2;
$temp;
} else {
"cur_opcode[" . $count++ . "]"
}
} @params];
}
my $orig = $file;
open INPUT, $file or die "Can't open $file, $!/$^E";
if (! ($file =~ s/\.ops$/.c/)) {
$file .= ".c";
}
#
# Read through the file, generating C source code:
#
my($name, $footer, @param_sub);
while (<INPUT>) {
my $op_size = 1;
next if m|^\s*$|; # Skip blank lines
next if m|^\s*/\*.*\*/\s*$|; # Skip comment-only lines
if (/^AUTO_OP/) {
($name, $footer, $op_size) = gen_auto_header($_);
die unless defined $op_size;
}
if (/^MANUAL_OP/) {
($name, $footer, $op_size) = gen_manual_header($_);
die unless defined $op_size;
}
if (/^(AUTO|MANUAL)_OP/) {
my $count = 1;
@param_sub = ("",
map {if ($_ eq "n") {
my $temp = '*(NV *)&{{\@$count}}';
$count += 2;
$temp;
} else {
"{{\@" . $count++ . "}}";
}
} @{$opcodes{$name}{TYPES}});
next;
}
s/RETVAL/goto {{+=$op_size}}/;
s/RETURN\(0\);/goto {{0}};/;
s/RETURN\((.*)\)/goto {{+=$1}}/;
s/\bP(\d+)\b/$param_sub[$1]/g;
if (/^}/) {
$current_body .= "$footer\n";
next;
}
$current_body .= $_;
}
if ($current_name ne '') {
$op_body{$current_name} = $current_body;
}
#print "OPS:\n";
#print join(', ', sort keys %op_body), "\n";
return;
}
sub gen_auto_header {
my ($line) = @_;
my ($name) = $line =~ /AUTO_OP\s+(\w+)/;
if ($current_name ne '') {
$op_body{$current_name} = $current_body;
}
$current_name = $name;
$current_body = '';
my $psize=0;
foreach (@{$opcodes{$name}{TYPES}}) {
$psize+=$psize{$_};
}
my $return_offset = $psize + 1;
$opcode{$name}{RETURN_OFFSET} = 1 + $psize;
$current_body .= "{{=}}: { /* $name */\n";
return($name, " goto {{+=$return_offset}};\n}\n", $return_offset);
}
sub gen_manual_header {
my ($line) = @_;
my ($name) = $line =~ /MANUAL_OP\s+(\w+)/;
if ($current_name ne '') {
$op_body{$current_name} = $current_body;
}
$current_name = $name;
$current_body = '';
my $psize=0;
foreach (@{$opcodes{$name}{TYPES}}) {
$psize+=$psize{$_};
}
my $return_offset = $psize + 1;
$opcode{$name}{RETURN_OFFSET} = 1 + $psize;
$current_body .= "{{=}}: { /* $name */\n";
return($name, " goto {{+=$return_offset}};\n}\n", $return_offset);
}
1;
#! /usr/bin/perl -w
#
# compile.pl
#
# Turn a parrot bytecode file into text.
#
# Copyright (C) 2001 The Parrot Team. All rights reserved.
# This program is free software. It is subject to the same license
# as the Parrot interpreter.
#
# $Id: $
#
use strict;
use Parrot::Opcode;
use Parrot::PackFile;
use Parrot::PackFile::ConstTable;
use Parrot::OpFunc;
Parrot::OpFunc->init('basic_opcodes.ops');
#
# GLOBAL VARIABLES:
#
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,
);
my %opcodes = Parrot::Opcode::read_ops();
my $opcode_fingerprint = Parrot::Opcode::fingerprint();
my @opcodes;
for my $name (keys %opcodes) {
$opcodes[$opcodes{$name}{CODE}] = { NAME => $name,
%{$opcodes{$name}} };
}
#
# dump_const_table()
#
sub dump_const_table {
my ($pf) = @_;
my $count = $pf->const_table->const_count;
if ($count < 1) {
warn "Disassembling without opcode table fingerprint!";
return;
}
die "Cannot compile (differing opcode table)!"
if $pf->const_table->constant(0)->data ne $opcode_fingerprint;
print "# Constants: $count entries\n";
print "# ID Flags Encoding Type Size Data\n";
my $constant_num = 0;
foreach ($pf->const_table->constants) {
printf("%04x: %08x %08x %08x %08x %s\n",
$constant_num, $_->flags, $_->encoding, $_->type,
$_->size, $_->data);
$constant_num++;
}
}
#
# compile_byte_code()
#
sub compile_byte_code {
my ($pf) = @_;
my $pc;
my $new_pc = 1;
my $op_size;
print <<END_C;
#include "parrot/parrot.h"
#include <math.h>
int
main(int argc, char **argv) {
int i;
struct Parrot_Interp *interpreter;
init_world();
interpreter = make_interpreter();
END_C
my $cursor = 0;
my $length = length($pf->byte_code);
my $offset=0;
while ($offset + 4 <= $length) {
$pc = $new_pc;
my $op_start = $offset;
my $op_code = unpack "x$offset l", $pf->byte_code;
my $op_name = $opcodes[$op_code]{NAME};
printf "/* $opcodes[$op_code]{NAME} ";
$offset += 4;
$op_size = 1;
my $arg_count = $opcodes[$op_code]{ARGS};
my @args = ();
my @comment_args = ();
if ($arg_count) {
foreach (0 .. $arg_count - 1) {
my $type = $opcodes[$op_code]{TYPES}[$_];
my $unpack_type = $unpack_type{$type};
my $unpack_size = $unpack_size{$type};
die "$0: Premature end of bytecode in argument.\n"
if ($offset + $unpack_size) > $length;
my $arg = unpack "x$offset $unpack_type", $pf->byte_code;
$offset += $unpack_size;
$op_size += $unpack_size / 4;
if($type =~ m/^[INPS]$/) { # Register
push @args, $arg;
push @comment_args, $type . $arg;
} elsif($type eq "D") { # destination address
push @args, "$arg";
push @comment_args, $arg;
} elsif($type eq "s") { # string constant
push @args, $arg;
push @comment_args, "[String $arg]";
} else { # constant
push @args, $arg;
push @comment_args, $arg;
}
}
print join(", ", @comment_args);
}
print " */\n";
# print "/* OP $op_name [$op_code] */\n";
my $body = $op_body{$op_name};
#
# Map {{@N}} ==> $args[N - 1]
#
while ($body =~ m/{{@(\d+)}}/m) {
my $rep = $args[$1 - 1];
$body =~ s/{{@(\d+)}}/$rep/m;
}
#
# Map {{=}} ==> PC_$pc
#
while ($body =~ m/{{=}}/m) {
my $rep = "PC_$pc";
$body =~ s/{{=}}/$rep/m;
}
#
# Map {{+=N}} ==> PC_$new_pc (where $new_pc = $pc + N)
#
$body =~ s/\+=-/-=/mg;
while ($body =~ m/{{([+-])=(\d+)}}/m) {
my $rep = "PC_" . ($pc + "$1$2");
$body =~ s/{{[+-]=(\d+)}}/$rep/m;
}
#
# Map {{N}} ==> PC_N
#
$body =~ s/\+=-/-=/mg;
while ($body =~ m/{{(\d+)}}/m) {
my $rep = "PC_$1";
$body =~ s/{{(\d+)}}/$rep/m;
}
print $body;
$new_pc = $pc + $op_size;
}
print <<END_C;
PC_$new_pc:
PC_0: {
exit(0);
}
return 0;
}
END_C
return 0;
}
#
# compile_file()
#
sub compile_file {
my ($file_name) = @_;
my $pf = Parrot::PackFile->new;
$pf->unpack_file($file_name);
# dump_const_table($pf);
compile_byte_code($pf);
undef $pf;
return;
}
#
# MAIN PROGRAM:
#
@ARGV = qw(-) unless @ARGV;
foreach (@ARGV) {
compile_file($_)
}
exit 0;
__END__
=head1 NAME
compile.pl - compile the byte code from Parrot Pack Files to C
=head1 SYNOPSIS
perl compile.pl FILE
=head1 DESCRIPTION
Compile the Parrot Pack Files listed on the command line, or
from standard input if no file is named.
=head1 COPYRIGHT
Copyright (C) 2001 The Parrot Team. All rights reserved.
=head1 LICENSE
This program is free software. It is subject to the same license
as the Parrot interpreter.
