Ok, this is a big one. Over 500 line diff, plus a new module
for parrot/Parrot.
This patch adds a prompt to Configure.pl to allow the choice
of DO_OP() as a function dereference (current behavior) or
as a C switch() statement.
Current up until Gregor applied 2 of Bryan's patches this evening.
I hope they don't mess it up, as I haven't the energy tonight
to do more. :-(
This patchset gave the following, when run with options for
function dereference ( the current mode ), and the switch()
[ SuSE linux x86 750Mhz Athlon, 256MB RAM ]
Normal:
Iterations: 100000000
Start time: 1002505053
End time: 1002505082
Count: 100000000
Elapsed time:29
Estimated ops:300000000
Estimated ops (numerically):300000000.000000
Elapsed time:29
Elapsed time:29.000000
Ops/sec:10344827.586207
Switched:
Iterations: 100000000
Start time: 1002507616
End time: 1002507639
Count: 100000000
Elapsed time:23
Estimated ops:300000000
Estimated ops (numerically):300000000.000000
Elapsed time:23
Elapsed time:23.000000
Ops/sec:13043478.260870
and courtesy of Mr. Schwern (debian on PowerPC, I believe)
Normal:
Iterations: 100000000
Start time: 1002507775
End time: 1002507838
Count: 100000000
Elapsed time:63
Estimated ops:300000000
Estimated ops (numerically):300000000.000000
Elapsed time:63
Elapsed time:63.000000
Ops/sec:4761904.761905
Switched:
Iterations: 100000000
Start time: 1002508550
End time: 1002508596
Count: 100000000
Elapsed time:46
Estimated ops:300000000
Estimated ops (numerically):300000000.000000
Elapsed time:46
Elapsed time:46.000000
Ops/sec:6521739.130435
------------------------------------------------------------------
Questions, comments, criticisms?
Cheers.
--
Michael Fischer 7.5 million years to run
[EMAIL PROTECTED] printf "%d", 0x2a;
-- deep thought
diff -ru parrot/Configure.pl parrot-switched/Configure.pl
--- parrot/Configure.pl Thu Oct 4 16:19:38 2001
+++ parrot-switched/Configure.pl Sun Oct 7 21:59:27 2001
@@ -85,6 +85,7 @@
perl => $^X,
debugging => $opt_debugging,
rm_f => 'rm -f',
+ do_op_t => 'switch',
);
#copy the things from --define foo=bar
@@ -108,6 +109,7 @@
prompt("How big would you like integers to be?", 'iv');
prompt("And your floats?", 'nv');
prompt("What is your native opcode type?", 'opcode_t');
+prompt("Opcode dispatch by switch or function ('switch' or 'func')", 'do_op_t');
unless( $c{debugging} ) {
$c{ld_debug} = ' ';
diff -ru parrot/MANIFEST parrot-switched/MANIFEST
--- parrot/MANIFEST Sat Oct 6 08:41:57 2001
+++ parrot-switched/MANIFEST Sun Oct 7 21:59:35 2001
@@ -14,6 +14,7 @@
Parrot/String.pm
Parrot/Test.pm
Parrot/Vtable.pm
+Parrot/PPP.pm
Test/More.pm
Test/Simple.pm
Test/Utils.pm
diff -ru parrot/Makefile.in parrot-switched/Makefile.in
--- parrot/Makefile.in Sun Oct 7 10:41:18 2001
+++ parrot-switched/Makefile.in Sun Oct 7 21:59:35 2001
@@ -18,6 +18,7 @@
PERL = ${perl}
TEST_PROG = test_prog${exe}
PDUMP = pdump${exe}
+DO_OP_T = ${do_op_t}
.c$(O):
$(CC) $(CFLAGS) -o $@ -c $<
@@ -31,7 +32,7 @@
$(TEST_PROG): test_main$(O) $(O_FILES) interp_guts$(O) op_info$(O)
$(CC) $(CFLAGS) -o $(TEST_PROG) $(O_FILES) interp_guts$(O) op_info$(O)
test_main$(O) $(C_LIBS)
-
+
$(PDUMP): pdump$(O) packfile$(O) memory$(O) global_setup$(O) string$(O) strnative$(O)
$(CC) $(CFLAGS) -o $(PDUMP) pdump$(O) packfile$(O) memory$(O) global_setup$(O)
string$(O) strnative$(O) $(C_LIBS)
@@ -44,7 +45,7 @@
strnative$(O): $(H_FILES)
$(INC)/interp_guts.h interp_guts.c $(INC)/op_info.h op_info.c: opcode_table
build_interp_starter.pl
- $(PERL) build_interp_starter.pl
+ $(PERL) build_interp_starter.pl -t $(DO_OP_T)
interpreter$(O): interpreter.c $(H_FILES) $(INC)/interp_guts.h
@@ -59,7 +60,7 @@
basic_opcodes$(O): $(H_FILES) basic_opcodes.c
basic_opcodes.c: basic_opcodes.ops process_opfunc.pl $(INC)/interp_guts.h
- $(PERL) process_opfunc.pl basic_opcodes.ops
+ $(PERL) process_opfunc.pl > basic_opcodes.c
$(INC)/op.h: opcode_table make_op_header.pl
$(PERL) make_op_header.pl opcode_table > $(INC)/op.h
Only in parrot-switched/Parrot: PPP.pm
diff -ru parrot/basic_opcodes.ops parrot-switched/basic_opcodes.ops
--- parrot/basic_opcodes.ops Sun Oct 7 11:27:42 2001
+++ parrot-switched/basic_opcodes.ops Sun Oct 7 21:59:35 2001
@@ -1,11 +1,3 @@
-/* basic_opcodes.c
- *
- * Just some basic opcodes
- *
- */
-
-#include "parrot/parrot.h"
-#include <math.h>
/* SET Ix, CONSTANT */
AUTO_OP set_i_ic {
diff -ru parrot/build_interp_starter.pl parrot-switched/build_interp_starter.pl
--- parrot/build_interp_starter.pl Sun Oct 7 20:46:15 2001
+++ parrot-switched/build_interp_starter.pl Sun Oct 7 21:59:35 2001
@@ -7,6 +7,16 @@
use strict;
use Parrot::Opcode;
+use Parrot::PPP;
+
+use Getopt::Std;
+
+use vars qw($opt_t);
+getopts('t:');
+
+die "You didn't specifiy how you want DO_OP written!\n
+Use the -t ['func' | 'switch' ] flag, please\n"
+unless $opt_t eq 'func' or $opt_t eq 'switch';
my %opcodes = Parrot::Opcode::read_ops();
my $opcode_fingerprint = Parrot::Opcode::fingerprint();
@@ -37,7 +47,10 @@
extern op_func_table_t builtin_op_func_table;
+CONST
+if ($opt_t eq 'func') {
+ print INTERP_GUTS_H <<EOI;
/*
* DO_OP macro:
*
@@ -46,11 +59,20 @@
*/
#define DO_OP(PC,INTERP) PC = ((INTERP->opcode_funcs)[*PC])(PC,INTERP);
+EOI
+}
+elsif ( $opt_t eq 'switch' ) {
+ print INTERP_GUTS_H Parrot::PPP::opcode_enum(%opcodes);
+ print INTERP_GUTS_H Parrot::PPP::process_opcodes($opt_t, %opcodes);
+}
+
+print INTERP_GUTS_H <<EOII;
+
#define OPCODE_FINGERPRINT "$opcode_fingerprint"
#endif /* INTERP_GUTS_H */
+EOII
-CONST
###############################################################################
diff -ru parrot/include/parrot/parrot.h parrot-switched/include/parrot/parrot.h
--- parrot/include/parrot/parrot.h Sat Oct 6 08:41:58 2001
+++ parrot-switched/include/parrot/parrot.h Sun Oct 7 21:59:57 2001
@@ -25,6 +25,7 @@
#include <stdio.h>
/*#include <types.h> */
#include <time.h>
+#include <math.h>
#ifdef WIN32
# include <io.h>
diff -ru parrot/process_opfunc.pl parrot-switched/process_opfunc.pl
--- parrot/process_opfunc.pl Sun Oct 7 11:27:42 2001
+++ parrot-switched/process_opfunc.pl Sun Oct 7 21:59:35 2001
@@ -1,120 +1,24 @@
-#! 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 ...
-#
-# 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
-
+#!/usr/bin/perl -w
use strict;
+
+use Parrot::PPP;
use Parrot::Opcode;
use Parrot::Config;
use Parrot::Types;
-my %opcodes = Parrot::Opcode::read_ops();
-
-my $orig = 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";
-print OUTPUT <<EOF;
-/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
- This file is built by $orig from its data. Any changes made here
- will be lost!
-*/
-
-EOF
-
-
-my($name, $footer, @param_sub);
-while (<INPUT>) {
-
- if (/^AUTO_OP/) {
- ($name, $footer) = emit_auto_header($_);
- }
-
- if (/^MANUAL_OP/) {
- ($name, $footer) = emit_manual_header($_);
- }
-
- if (/^(AUTO|MANUAL)_OP/) {
- my $count = 1;
- @param_sub = ("",
- map { "cur_opcode[" . $count++ . "]" } @{$opcodes{$name}{TYPES}});
- next;
- }
-
- s/RETVAL/return_offset/;
-
- s/RETURN\(0\);/return 0;/;
-
- s/RETURN\((.*)\)/return cur_opcode + $1/;
- s/RESUME\((.*)\)/interpreter->resume_addr = cur_opcode + $1/;
-
- s/\bP(\d+)\b/$param_sub[$1]/g;
- s/INT_REG\(([^)]+)\)/interpreter->int_reg->registers[$1]/g;
- s/STR_REG\(([^)]+)\)/interpreter->string_reg->registers[$1]/g;
- s/PMC_REG\(([^)]+)\)/interpreter->pmc_reg->registers[$1]/g;
- s/NUM_REG\(([^)]+)\)/interpreter->num_reg->registers[$1]/g;
-
- s/NUM_CONST\(([^)]+)\)/interpreter->code->const_table->constants[$1]->number/g;
- s/STR_CONST\(([^)]+)\)/interpreter->code->const_table->constants[$1]->string/g;
- s/INT_CONST\(([^)]+)\)/$1/g;
-
- if (/^}/) {
- print OUTPUT $footer, "\n";
- next;
- }
-
- print OUTPUT $_;
-}
-
-sub emit_auto_header {
- my $line = shift;
- my ($name) = $line =~ /AUTO_OP\s+(\w+)/;
-
- my $return_offset = $opcodes{$name}{RETURN_OFFSET};
+my %opcodes = Parrot::Opcode::read_ops();
- print OUTPUT ("opcode_t *$opcodes{$name}{FUNC}".
- "(opcode_t cur_opcode[], struct Parrot_Interp *interpreter) {\n");
- return($name, " return cur_opcode + " . $return_offset . ";\n}\n");
-}
+#
+# Because build_interp_starter.pl wanted most of the functionality
+# originally found in this file, almost all the code was moved
+# to Parrot::PPP.pm (ParrotPreProcessor -- sorry, best I could think of).
+# Both driver scripts really want the same input file, "basic_opcodes.ops",
+# so I hardcoded that infile there.
+# So, for simplicity, it is easier to write the outuput filename
+# of this program driver ( basic_opcodes.c ) into the Makefile.in
+# with a shell redirect '>'
+#
-sub emit_manual_header {
- my $line = shift;
- my ($name) = $line =~ /MANUAL_OP\s+(\w+)/;
-
- my $return_offset = $opcodes{$name}{RETURN_OFFSET};
-
- print OUTPUT ("opcode_t *$opcodes{$name}{FUNC}".
- "(opcode_t cur_opcode[], struct Parrot_Interp *interpreter) {\n");
- print OUTPUT " INTVAL return_offset = $return_offset;\n";
- return($name, " return cur_opcode + return_offset;\n}\n");
-}
+print Parrot::PPP::process_opcodes('func', %opcodes);
--- /dev/null Tue Aug 22 11:27:21 2000
+++ parrot-switched/Parrot/PPP.pm Sun Oct 7 21:59:41 2001
@@ -0,0 +1,235 @@
+package Parrot::PPP;
+use Exporter;
+@Parrot::PPP::ISA = qw(Exporter);
+@Parrot::PPP::EXPORT = qw(pprocess_opcodes opcode_enum);
+
+use strict;
+
+#
+# Parrot Pre-Processor, for lack of a better name
+#
+
+# define a sub which will
+# 1) normative circs, write out basic_opcodes.c, func defs in c.
+# 2) use the same info to write the switch() statement.
+#
+
+
+
+
+my %preliminaries = (
+ 'func' => qq|
+/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+ This file is built by basic_opcodes.ops from its data. Any changes made here
+ will be lost!
+*/
+
+
+/* basic_opcodes.c
+ *
+ * Just some basic opcodes
+ *
+ */
+
+#include "parrot/parrot.h"
+#include <math.h>
+
+|,
+ 'switch' => qq|
+
+#define DO_OP(pc, interpreter) do { \\
+switch(*pc) { \\
+|,
+ );
+
+
+#
+# but do I want
+# interpreter->opcode_funcs[*temp]
+# ??????
+#
+#
+#
+# pprocess_opcodes($outfile,$flag)
+#
+# Opens and loops through basic_opcodes.ops,
+# transforms the lines for
+# a) basic_opcodes.c -- C function definitions for the opcodes
+# b) a #define for DO_OPS() written as a C switch
+#
+# Builds a whoping $c_code string to be printed $wherever
+# by the caller
+#
+# $flag is one of 'func' or 'switch'
+#
+sub process_opcodes {
+ my ($flag, %opcodes) = @_;
+ my $c_code;
+ my $type;
+ my($name, $footer, $immediate_output, @param_sub);
+ my $infile = "basic_opcodes.ops";
+
+ open INPUT, $infile or die "Couldn't open $infile: $!\n";
+
+ $c_code = $preliminaries{$flag};
+
+ while (<INPUT>) {
+
+ if ( $flag eq 'switch' ) {
+ chomp;
+ s|#include.*||; # we don't want them for interp_guts.h
+ s|/\*.+||; # strip C comments
+ }
+
+ if (/^AUTO_OP/) {
+ $type = 'AUTO';
+ ($name, $footer, $immediate_output) = emit_auto_header($_, $flag,
+%opcodes);
+ $c_code .= $immediate_output;
+ }
+
+ if (/^MANUAL_OP/) {
+ $type = 'MANUAL';
+ ($name, $footer, $immediate_output) = emit_manual_header($_, $flag,
+%opcodes);
+ $c_code .= $immediate_output;
+ }
+
+ if (/^(AUTO|MANUAL)_OP/) {
+ my $count = 1;
+ @param_sub = ("",
+ map { $flag eq 'func'
+ ? "cur_opcode[" . $count++ . "]"
+ : "pc[" . $count++ . "]"
+ } @{$opcodes{$name}{TYPES}});
+ next;
+ }
+
+ if ( $flag eq 'func' ) {
+ s/RETURN\(0\);/return 0;/;
+ s/RETURN\((.*)\)/return cur_opcode + $1/;
+ s/RESUME\((.*)\)/interpreter->resume_addr = cur_opcode + $1/;
+ }
+ elsif ( $flag eq 'switch' ) {
+ s/RETURN\(0\)/pc = 0/;
+ s/RESUME\((.*)\)/interpreter->resume_addr = pc + $1/;
+ if ( $type eq 'AUTO' ) {
+ s/RETURN\((.*)\)/pc += $1/;
+ }
+ elsif ( $type eq 'MANUAL' ) {
+ s/RETURN\((.*)\);/pc += $1; \\\n break; \\\n/;
+ }
+ }
+
+ s/\bP(\d+)\b/$param_sub[$1]/g;
+ s/INT_REG\(([^)]+)\)/interpreter->int_reg->registers[$1]/g;
+ s/STR_REG\(([^)]+)\)/interpreter->string_reg->registers[$1]/g;
+ s/PMC_REG\(([^)]+)\)/interpreter->pmc_reg->registers[$1]/g;
+ s/NUM_REG\(([^)]+)\)/interpreter->num_reg->registers[$1]/g;
+
+ s/NUM_CONST\(([^)]+)\)/interpreter->code->const_table->constants[$1]->number/g;
+ s/STR_CONST\(([^)]+)\)/interpreter->code->const_table->constants[$1]->string/g;
+ s/INT_CONST\(([^)]+)\)/$1/g;
+
+ if (/^}/) {
+# $flag eq 'switch' && s/^}//;
+ my %eol = ('func' => "\n", 'switch' => " \\\n break; \\\n} \\\n");
+ $c_code .= $footer . $eol{$flag};
+ next;
+ }
+
+ if ( /\S+/ ) {
+ if ( $flag eq 'switch' ) {
+ $c_code .= "$_ \\\n";
+ }
+ else {
+ $c_code .= $_;
+ }
+ }
+ else { next; }
+ }
+ if ($flag eq 'switch') {
+ $c_code .= "} \\\n" . "} while (0);\n";
+ }
+ return $c_code;
+}
+
+
+sub emit_auto_header {
+ my ($line, $flag, %opcodes) = @_;
+ my ($name) = $line =~ /AUTO_OP\s+(\w+)/;
+
+ my $return_offset = $opcodes{$name}{RETURN_OFFSET};
+
+ my ($output, $footer);
+ if ( $flag eq 'func' ) {
+ $output = "opcode_t *$opcodes{$name}{FUNC}".
+ "(opcode_t cur_opcode[], struct Parrot_Interp *interpreter) {\n";
+ $footer = " return cur_opcode + " . $return_offset . ";\n}\n";
+ }
+ elsif ( $flag eq 'switch' ) {
+ $output = "case $name" . "_idx: \\\n" . "{ \\\n";
+ $footer = " pc += " . $return_offset . ";";
+ }
+ return($name, $footer, $output);
+}
+
+sub emit_manual_header {
+ my ($line, $flag, %opcodes) = @_;
+ my ($name) = $line =~ /MANUAL_OP\s+(\w+)/;
+
+ my $return_offset = $opcodes{$name}{RETURN_OFFSET};
+
+ my ($output, $footer);
+ if ( $flag eq 'func' ) {
+ $output = "opcode_t *$opcodes{$name}{FUNC}".
+ "(opcode_t cur_opcode[], struct Parrot_Interp *interpreter) {\n";
+ $output .= " INTVAL return_offset = $return_offset;\n";
+ $footer = " return cur_opcode + return_offset;\n}\n"
+ }
+ elsif ( $flag eq 'switch' ) {
+ $output = "case $name" . "_idx: \\\n" . "{ \\\n";
+ $footer = " pc += $return_offset;";
+ if ( $name =~ /end|jump_i|branch_ic/ ) {
+ $footer = "";
+ }
+ }
+ return($name, $footer, $output);
+}
+
+#
+# opcode_enum just something to make the switch more readable
+#
+
+#
+# stick [ print INTERP opcode_enum(); ] in build_interp_starter.pl
+#
+sub opcode_enum {
+ my ( %opcodes ) = @_;
+ my $enum = "
+
+
+/* just a convenience for legibility of the switch() in DO_OP() */
+/* the '_idx' is to prevent a namespace clash with 'Parrot_opname_foo' */
+";
+ $enum .= "enum {\n";
+ $enum .=
+ join ",\n",
+ map { "\t$_" . "_idx" }
+ sort {$opcodes{$a}{CODE} <=> $opcodes{$b}{CODE}}
+ keys %opcodes;
+
+ $enum .= "};\n\n";
+ return $enum;
+}
+
+
+"SQUAWK";
+
+=head1 NAME
+
+Parrot::PPP - routines for preprocessing basic_opcodes.ops
+into various other forms (DO_OPS() as a C switch(), basic_opcodes.c)
+
+=head1 DESCRIPTION
+
+No user-serviceable parts inside.
+
