cvsuser 04/03/10 01:31:16
Modified: . MANIFEST
classes delegate.pmc
ops io.ops
src trace.c
Added: tools/dev bench_op.imc
Log:
new tool: bench_op - benchmarks opcode(s)
and some bug fixes:
* pmc = new delegate leaked memory, if no __init was found
* open didn't return PerlUndef on failure
* print I and N reg contents in trace
Revision Changes Path
1.591 +1 -0 parrot/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.590
retrieving revision 1.591
diff -u -w -r1.590 -r1.591
--- MANIFEST 10 Mar 2004 02:05:29 -0000 1.590
+++ MANIFEST 10 Mar 2004 09:30:58 -0000 1.591
@@ -2526,6 +2526,7 @@
t/src/manifest.t []
t/src/sprintf.t []
t/stress/gc.t []
+tools/dev/bench_op.imc [devel]
tools/dev/cc_flags.pl []
tools/dev/check_source_standards.pl [devel]
tools/dev/extract_file_descriptions.pl [devel]
1.1 parrot/tools/dev/bench_op.imc
Index: bench_op.imc
===================================================================
=head1 TITLE
bench_op - Benchmark one or more opcodes
=head1 SYNOPSIS
parrot bench_op.imc 'add $I0, $I1, $I2'
parrot bench_op.imc --preops='newclass $P0, "Foo"' file_w_ops.imc
parrot bench_op.imc --help
=head1 DESCRIPTION
The given opcode(s) are compiled into a sequence:
.sub _entry0
.param int N
.local int i
#
# preops go here
#
null i
loop:
#
# ops go here
#
inc i
lt i, N, loop
invoke P1
.end
so they should conform to PCC, specifically they should not destroy the return
continuation and not use registers in the lower frames. The code gets executed
with the PIR compiler - using symbolic variables is always ok.
Output is the time in seconds for 1.000.000 instruction(s).
=head1 OPTIONS
=over 4
=item I<--times=N>
Run the given opcode(s) in a loop I<N> time.
If no I<--times> options is given 100.000 is used.
=item I<--verbose[=2]>
Set I<--verbose> to 2 to see the compiled programs.
=item I<--preops='opcode(s)'>
Execute the given opcodes in front of the loop. This is needed for ops,
that have side effects like B<newclass>.
=item I<--help>
Print a short description
=item I<--version>
Print program version.
=back
=cut
.include "Getopt_Long.imc"
.const string VERSION = "0.1.0"
.sub _main @MAIN
.param pmc argv
.local pmc opt_spec
.local int times
.local int verbose
times = 100000
verbose = 0
opt_spec = new PerlArray
push opt_spec, "version=i"
push opt_spec, "verbose"
push opt_spec, "help"
push opt_spec, "times=i"
push opt_spec, "preops=s"
.local string program
shift program, argv
.local pmc opt
opt = new PerlUndef
opt = _get_options( argv, opt_spec )
.local int def
def = defined opt
unless def goto do_help
def = defined opt["version"]
if def goto do_def
def = defined opt["help"]
if def goto do_help
def = defined opt["times"]
unless def goto default_times
times = opt["times"]
default_times:
def = defined opt["verbose"]
unless def goto default_verbose
verbose = opt["verbose"]
default_verbose:
.local string preops
def = defined opt["preops"]
unless def goto default_preops
preops = opt["preops"]
default_preops:
_run( argv, times, verbose, preops)
end
do_def:
print program
print ": Version "
print VERSION
print "\n"
end
do_help:
print program
print " [--help] [--version] [--verbose[=2]] [--times=N] \\ \n"
print "\t[--preops='op(s)'] file | opcode\n"
print "\nRun opcode on commandline or from file <N> times.\n"
print "s. perldoc -F "
print program
print "\n"
end
.end
.sub _run
.param pmc argv
.param int times
.param int verbose
.param string preops
.local string op
shift op, argv
unless verbose goto no_v1
print "Running '"
print op
print "' "
print times
print " times\n"
no_v1:
# op may be a file or an opcode - try to open it
.local pmc F
open F, op, "<"
.local int def
def = defined F
unless def goto op_is_op
read op, F, 10000 # TODO use stat
close F
op_is_op:
.local float empty
empty = _bench(times, verbose, '', '')
unless verbose goto no_v2
print "Empty "
print empty
print "\n"
no_v2:
.local float test
.local float diff
test = _bench(times, verbose, op, preops)
diff = test - empty
unless verbose goto no_v3
print "Total "
print test
print "\n"
print "Prog "
print diff
print "\n"
no_v3:
test = diff * 1.0E6
test = test / times
print "Time for 1M ins: "
print test
print "\n"
.end
.sub _bench
.param int n
.param int verbose
.param string ops
.param string preops
.local pmc compiler
.local pmc compiled
.local int l
.local string ls
.local string prog
length l, ops
ls = l
.local string entry_label
entry_label = "_entry" . ls
compreg compiler, "PIR" # TODO PASM option
prog = ".sub " . entry_label
prog = prog . "\n.param int N\n.local int i\n"
prog = prog . preops
prog = prog . "\nloop:\n"
prog = prog . ops
prog = prog . "\ninc i\nlt i, N, loop\ninvoke P1\n.end\n"
if verbose < 2 goto no_v2
print prog
no_v2:
compile compiled, compiler, prog
.local float now
time now
.local pmc entry
.local pmc retc
find_global entry, entry_label
newsub retc, .RetContinuation, retl
.pcc_begin prototyped
.arg n
.pcc_call entry, retc
retl:
.pcc_end
.local float later
time later
later = later - now
.pcc_begin_return
.return later
.pcc_end_return
.end
=head1 BUGS
You can't use the variables I<i> and I<N> nor the labels I<loop:> and
I<_entry\d> in your opcodes.
=head1 AUTHOR
Leopold Toetsch <[EMAIL PROTECTED]>
=cut
# vim: expandtab sw=4 tw=70:
1.17 +3 -2 parrot/classes/delegate.pmc
Index: delegate.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/delegate.pmc,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- delegate.pmc 6 Mar 2004 14:26:02 -0000 1.16
+++ delegate.pmc 10 Mar 2004 09:31:08 -0000 1.17
@@ -1,6 +1,6 @@
/*
Copyright: 2003 The Perl Foundation. All Rights Reserved.
-$Id: delegate.pmc,v 1.16 2004/03/06 14:26:02 leo Exp $
+$Id: delegate.pmc,v 1.17 2004/03/10 09:31:08 leo Exp $
=head1 NAME
@@ -183,7 +183,7 @@
PMC *method = die ? find_or_die(interpreter, obj, meth) :
find_meth (interpreter, obj, meth);
if (PMC_IS_NULL(method))
- return;
+ goto ret;
REG_PMC(2) = obj;
REG_INT(0) = 1; /* prototyped */
REG_INT(1) = 0;
@@ -191,6 +191,7 @@
REG_INT(3) = 0;
REG_INT(4) = 0;
Parrot_runops_fromc(interpreter, method);
+ret:
restore_regs(interpreter, data);
}
1.44 +1 -1 parrot/ops/io.ops
Index: io.ops
===================================================================
RCS file: /cvs/public/parrot/ops/io.ops,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -w -r1.43 -r1.44
--- io.ops 19 Feb 2004 20:30:13 -0000 1.43
+++ io.ops 10 Mar 2004 09:31:12 -0000 1.44
@@ -154,7 +154,7 @@
$1 = PIO_open(interpreter, NULL, path, mode);
/* string_cstring_free(mode); */
/* string_cstring_free(path); */
- if(!$1) {
+ if(!$1 || !PMC_struct_val($1)) {
$1 = pmc_new(interpreter, enum_class_PerlUndef);
}
goto NEXT();
1.51 +9 -1 parrot/src/trace.c
Index: trace.c
===================================================================
RCS file: /cvs/public/parrot/src/trace.c,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -w -r1.50 -r1.51
--- trace.c 9 Mar 2004 17:03:35 -0000 1.50
+++ trace.c 10 Mar 2004 09:31:16 -0000 1.51
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: trace.c,v 1.50 2004/03/09 17:03:35 leo Exp $
+$Id: trace.c,v 1.51 2004/03/10 09:31:16 leo Exp $
=head1 NAME
@@ -209,9 +209,11 @@
break;
case PARROT_ARG_I:
PIO_eprintf(interpreter, "I%vd", o);
+ more = 1;
break;
case PARROT_ARG_N:
PIO_eprintf(interpreter, "N%vd", o);
+ more = 1;
break;
case PARROT_ARG_P:
PIO_eprintf(interpreter, "P%vd", o);
@@ -240,6 +242,12 @@
PIO_eprintf(interpreter, ", ");
}
switch (info->types[i]) {
+ case PARROT_ARG_I:
+ PIO_eprintf(interpreter, "I%vd=%vd", o, REG_INT(o));
+ break;
+ case PARROT_ARG_N:
+ PIO_eprintf(interpreter, "N%vd=%vf", o, REG_NUM(o));
+ break;
case PARROT_ARG_P:
PIO_eprintf(interpreter, "P%vd=", o);
trace_pmc_dump(interpreter, REG_PMC(o));
