dan 01/09/05 19:35:34
Added: . build_interp_starter.pl basic_opcodes.ops
process_opfunc.pl
Log:
Scripts to build the header file that holds the function table creation
code, as well as the script to turn an opcode file to C source. (And
the basic opcode functions turned into an opcode source file)
Revision Changes Path
1.1 parrot/build_interp_starter.pl
Index: build_interp_starter.pl
===================================================================
#! perl -w
#
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;
/*
*
* interp_guts.h
*
* this file is autogenerated by build_interp_starter.pl
*
* Best not edit it
*/
#define BUILD_TABLE(x) do { \\
CONST
while (<OPCODES>) {
chomp;
s/#.*$//;
s/^\s+//;
next unless $_;
($num, $name) = split /\s+/;
print INTERP "\tx[$num] = $name; \\\n";
$num++;
}
print INTERP "} while (0);\n";
1.1 parrot/basic_opcodes.ops
Index: basic_opcodes.ops
===================================================================
/* basic_opcodes.c
*
* Just some basic opcodes
*
*/
#include "parrot.h"
// SET Ix, CONSTANT
AUTO_OP set_i_ic {
INT_REG(cur_opcode[1]) = cur_opcode[2];
}
// ADD Ix, Iy, Iz
AUTO_OP add_i {
INT_REG(cur_opcode[1]) = INT_REG(cur_opcode[2]) +
INT_REG(cur_opcode[3]);
}
// SUB Ix, Iy, Iz
AUTO_OP sub_i {
INT_REG(cur_opcode[1]) = INT_REG(cur_opcode[2]) -
INT_REG(cur_opcode[3]);
}
// MUL Ix, Iy, Iz
AUTO_OP mul_i {
INT_REG(cur_opcode[1]) = INT_REG(cur_opcode[2]) *
INT_REG(cur_opcode[3]);
}
// DIV Ix, Iy, Iz
AUTO_OP div_i {
INT_REG(cur_opcode[1]) = INT_REG(cur_opcode[2]) /
INT_REG(cur_opcode[3]);
}
// EQ Ix, Iy, EQ_BRANCH, NE_BRANCH
MANUAL_OP eq_i_ic {
if (INT_REG(cur_opcode[1]) == INT_REG(cur_opcode[2])) {
RETURN(cur_opcode[3]);
} else {
RETURN(cur_opcode[4]);
}
}
// IF IXx, TRUE_BRANCH, FALSE_BRANCH
MANUAL_OP if_i_ic {
if (INT_REG(cur_opcode[1])) {
RETURN(cur_opcode[2]);
} else {
RETURN(cur_opcode[3]);
}
}
// TIME Ix
AUTO_OP time_i {
INT_REG(cur_opcode[1]) = time(NULL);
}
// PRINT Ix
AUTO_OP print_i {
printf("I reg %i is %i\n", cur_opcode[1], INT_REG(cur_opcode[1]));
}
// BRANCH CONSTANT
MANUAL_OP branch_ic {
RETURN(cur_opcode[1]);
}
// END
MANUAL_OP end {
RETURN(0);
}
// INC Ix
AUTO_OP inc_i {
INT_REG(cur_opcode[1])++;
}
// INC Ix, nnn
AUTO_OP inc_i_ic {
INT_REG(cur_opcode[1]) += cur_opcode[2];
}
// DEC Ix
AUTO_OP dec_i {
INT_REG(cur_opcode[1])--;
}
// DEC Ix, nnn
AUTO_OP dec_i_ic {
INT_REG(cur_opcode[1]) -= cur_opcode[2];
}
// JUMP Ix
MANUAL_OP jump_i {
RETURN(INT_REG(cur_opcode[1]));
}
// SET Nx, CONSTANT
AUTO_OP set_n_nc {
NUM_REG(cur_opcode[1]) = *(double *)&cur_opcode[2];
}
// ADD Nx, Ny, Nz
AUTO_OP add_n {
NUM_REG(cur_opcode[1]) = NUM_REG(cur_opcode[2]) +
NUM_REG(cur_opcode[3]);
}
// SUB Nx, Ny, Iz
AUTO_OP sub_n {
NUM_REG(cur_opcode[1]) = NUM_REG(cur_opcode[2]) -
NUM_REG(cur_opcode[3]);
}
// MUL Nx, Ny, Iz
AUTO_OP mul_n {
NUM_REG(cur_opcode[1]) = NUM_REG(cur_opcode[2]) *
NUM_REG(cur_opcode[3]);
}
// DIV Nx, Ny, Iz
AUTO_OP div_n {
NUM_REG(cur_opcode[1]) = NUM_REG(cur_opcode[2]) /
NUM_REG(cur_opcode[3]);
}
// EQ Nx, Ny, EQ_BRANCH, NE_BRANCH
MANUAL_OP eq_n_ic {
if (NUM_REG(cur_opcode[1]) == NUM_REG(cur_opcode[2])) {
RETURN(cur_opcode[3]);
} else {
RETURN(cur_opcode[4]);
}
}
// IF Nx, TRUE_BRANCH, FALSE_BRANCH
MANUAL_OP if_n_ic {
if (NUM_REG(cur_opcode[1])) {
RETURN(cur_opcode[2]);
} else {
RETURN(cur_opcode[3]);
}
}
// TIME Nx
AUTO_OP time_n {
NUM_REG(P1) = time(NULL);
}
// PRINT Nx
AUTO_OP print_n {
printf("N reg %i is %Lf\n", P1, NUM_REG(P1));
}
// INC Nx
AUTO_OP inc_n {
NUM_REG(P1) += 1;
}
// INC Nx, nnn
AUTO_OP inc_n_nc {
(NV)NUM_REG(P1) += *(double *)&cur_opcode[2];
}
// DEC Nx
AUTO_OP dec_n {
NUM_REG(P1) -= 1;
}
// DEC Nx, nnn
AUTO_OP dec_n_nc {
NUM_REG(P1) += *(double *)&cur_opcode[2];
}
// ITON Nx, Iy
AUTO_OP iton_n_i {
IV number;
number = INT_REG(P2);
NUM_REG(P1) = (NV)number;
}
// NTOI Ix, Ny
AUTO_OP ntoi_i_n {
NV number;
number = NUM_REG(P2);
INT_REG(P1) = number;
}
1.1 parrot/process_opfunc.pl
Index: process_opfunc.pl
===================================================================
#! perl -w
#
# process_opfunc.pl
#
# Take a file of opcode functions and emit 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 ...
#
# 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
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+/;
$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;
$opcode{$name}{RETURN_OFFSET} = 1 + $num_i + $num_n * 2;
my $count = 1;
$opcode{$name}{PARAMETER_SUB} = ["", map {"cur_opcode[" . $count++ . "]"}
@params];
}
my $file = $ARGV[0];
open INPUT, $file or die "Can't open $file, $!/$^E";
if (! ($file =~ s/\.ops$/.c/)) {
$file .= ".c";
}
open OUTPUT, ">$file" or die "Can't open $file, $!/$^E";
while (<INPUT>) {
if (/^AUTO_OP/) {
($name, $footer) = emit_auto_header($_);
next;
}
if (/^MANUAL_OP/) {
($name, $footer) = emit_manual_header($_);
next;
}
s/RETVAL/return_offset/;
s/RETURN\(0\);/return 0;/;
s/RETURN\((.*)\)/return cur_opcode + $1/;
s/\bP(\d+)\b/$opcode{$name}{PARAMETER_SUB}[$1]/g;
if (/^}/) {
print OUTPUT $footer, "\n";
next;
}
print OUTPUT $_;
}
sub emit_auto_header {
my $line = shift;
my ($name) = $line =~ /AUTO_OP\s+(\w+)/;
print OUTPUT "IV *$name(IV cur_opcode[], struct Perl_Interp *interpreter) {\n";
return($name, " return cur_opcode + "
. $opcode{$name}{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 return_offset = 1;\n";
return($name, " return cur_opcode + return_offset;\n}\n");
}
