cvsuser 04/10/28 02:43:05
Modified: . MANIFEST
examples/assembly getopt_demo.imc
runtime/parrot/library/Getopt Long.imc
Added: examples/benchmarks array_access.imc
t/library getopt_long.t
Log:
[perl #32176] [PATCH] Getopt/Long tidbits and Array access benchmark
this patch adds a benchmark for random access of different Array PMCs. The
script is heavily inspired by the 'Array Access' benchmark in the 'Great
Computer Language Shootout', http://shootout.alioth.debian.org.
At first glance the results are not very surprising. The more a PMC has to
do, the longer it takes.
As the benchmark script takes long command line parameters, I have added
some Getopt/Long tidbits.
The files 'examples/benchmarks/array_access.imc' and
't/library/getopt_long.t' are new.
Courtesy of Bernhard Schmalhofer <[EMAIL PROTECTED]>
Revision Changes Path
1.757 +2 -0 parrot/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/parrot/MANIFEST,v
retrieving revision 1.756
retrieving revision 1.757
diff -u -r1.756 -r1.757
--- MANIFEST 24 Oct 2004 09:50:51 -0000 1.756
+++ MANIFEST 28 Oct 2004 09:43:01 -0000 1.757
@@ -410,6 +410,7 @@
examples/benchmarks/addit.pl [main]doc
examples/benchmarks/addit.rb [main]doc
examples/benchmarks/addit2.imc [main]doc
+examples/benchmarks/array_access.imc [main]doc
examples/benchmarks/arriter.imc [main]doc
examples/benchmarks/arriter.pl [main]doc
examples/benchmarks/arriter.rb [main]doc
@@ -2836,6 +2837,7 @@
t/pmc/timer.t []
t/pmc/tqueue.t []
t/pmc/undef.t []
+t/library/getopt_long.t []
t/library/streams.t []
t/library/perlhist.txt []
t/library/sort.t []
1.1 parrot/examples/benchmarks/array_access.imc
Index: array_access.imc
===================================================================
# Copyright (C) 2001-2003 The Perl Foundation. All rights reserved.
# $Id: array_access.imc,v 1.1 2004/10/28 09:43:02 leo Exp $
=head1 NAME
examples/benchmarks/array_access.imc - Reading from array
=head1 SYNOPSIS
./parrot examples/benchmarks/array_access.imc --arr-size=1000
=head1 DESCRIPTION
Inspired by computer language shootout.
=cut
.include "library/Getopt/Long.imc"
.sub _main @MAIN
.param pmc argv
# name of the program
.local string program_name
program_name = shift argv
# Assemble specification for get_options
# in an array of format specifiers
.local pmc opt_spec
opt_spec = new PerlArray
push opt_spec, "arr-size=i"
# Make a copy of argv, because this can easier be handled in get_options()
.local pmc argv_clone
argv_clone = clone argv
.local pmc opt
( opt ) = _get_options( argv_clone, opt_spec )
.local int arr_size
S1 = opt['arr-size']
arr_size = S1
_bench( .Array, arr_size )
_bench( .FixedFloatArray, arr_size )
_bench( .FixedIntegerArray, arr_size )
_bench( .FixedPMCArray, arr_size )
_bench( .FixedStringArray, arr_size )
_bench( .IntList, arr_size )
_bench( .OrderedHash, arr_size )
_bench( .PerlArray, arr_size )
_bench( .PMCArray, arr_size )
_bench( .ResizableFloatArray, arr_size )
_bench( .ResizableIntegerArray, arr_size )
_bench( .ResizablePMCArray, arr_size )
_bench( .ResizableStringArray, arr_size )
_bench( .SArray, arr_size )
_bench( .StringArray, arr_size )
end
.end
=head2 void bench( int arr_class, int arr_size )
=cut
.sub _bench
.param int arr_class
.param int arr_size
# Two arrays with fixed size
.local pmc arr_1, arr_2
arr_1 = new arr_class
arr_1 = arr_size
arr_2 = new arr_class
arr_2 = arr_size
.local float start_time
start_time = time
# initialize arr_1 and arr_2
.local int x_index, value
x_index = 0
value = 1
X_LOOP:
if x_index >= arr_size goto X_DONE
arr_1[x_index] = value
arr_2[x_index] = 0
inc x_index
inc value
goto X_LOOP
X_DONE:
.local int max_index, z_index, y_index
max_index = arr_size - 1
y_index = 0
Y_LOOP: # 1000 iterations
if y_index >= 1000 goto Y_DONE
z_index = max_index
Z_LOOP: # arr_size iterations
if z_index < 0 goto Z_DONE
set I3, arr_2[z_index]
set I4, arr_1[z_index]
add I3, I4
arr_2[z_index] = I3
dec z_index
branch Z_LOOP
Z_DONE:
inc y_index
branch Y_LOOP
Y_DONE:
# final output
print "1 * 1000 = "
value = arr_2[0]
print value
print "\n"
print arr_size
print " * 1000 = "
value = arr_2[max_index]
print value
print "\n"
.local float start_time, end_time, span_time
end_time = time
span_time = end_time - start_time
.local string arr_type
arr_type = typeof arr_1
print arr_type
print ": "
print span_time
print "s\n\n"
.end
=head1 SEE ALSO
Computer language shootout. L<http://shootout.alioth.debian.org>
=cut
1.1 parrot/t/library/getopt_long.t
Index: getopt_long.t
===================================================================
# Copyright (C) 2001-2003 The Perl Foundation. All rights reserved.
# $Id: getopt_long.t,v 1.1 2004/10/28 09:43:03 leo Exp $
=head1 NAME
t/library/getopt_long.t - testing library/Getopt/Long.imc
=head1 SYNOPSIS
% perl -Ilib t/library/getopt_long.t
=head1 DESCRIPTION
This test program tries to handle command line arguments with the
library F<runtime/parrot/library/Getopt/Long.imc>.
=cut
use strict;
use Parrot::Test tests => 1;
# no. 1
output_is(<<'CODE', <<'OUT', "basic long options");
##PIR##
.sub _main
# Assemble specification for get_options
# in an array of format specifiers
.local pmc opt_spec
opt_spec = new ResizableStringArray
# --version, boolean
push opt_spec, "version"
# --help, boolean
push opt_spec, "help"
# --bool, boolean
push opt_spec, "bool"
# --string, string
push opt_spec, "string=s"
# --integer, integer
push opt_spec, "integer=i"
# This comes usually from the command line
.local pmc argv
argv = new PerlArray
push argv, "--help"
push argv, "--version"
push argv, "--string=asdf"
push argv, "--bool"
push argv, "--integer=42"
push argv, "some"
push argv, "thing"
.local pmc opt
( opt ) = _get_options( argv, opt_spec )
# Now we do what the passed options tell
.local int is_defined
# Was '--version' passed ?
is_defined = defined opt["version"]
unless is_defined goto NO_VERSION_FLAG
print "getopt_long.t 0.01\n"
NO_VERSION_FLAG:
# Was '--help' passed ?
is_defined = defined opt["help"]
unless is_defined goto NO_HELP_FLAG
print "This is just a test.\n"
NO_HELP_FLAG:
# handle the bool option
is_defined = defined opt["bool"]
unless is_defined goto NO_BOOL_OPTION
print "You have passed the option '--bool'.\n"
goto END_BOOL_OPTION
NO_BOOL_OPTION:
print "You haven't passed the option '--bool'. This is fine with me.\n"
END_BOOL_OPTION:
# handle the string option
is_defined = defined opt["string"]
unless is_defined goto NO_STRING_OPTION
.local string string_option
string_option = opt["string"]
print "You have passed the option '--string'. The value is '"
print string_option
print "'.\n"
goto END_STRING_OPTION
NO_STRING_OPTION:
print "You haven't passed the option '--string'. This is fine with me.\n"
END_STRING_OPTION:
# handle the integer option
is_defined = defined opt["integer"]
unless is_defined goto NO_INTEGER_OPTION
.local string integer_option
integer_option = opt["integer"]
print "You have passed the option '--integer'. The value is '"
print integer_option
print "'.\n"
goto END_INTEGER_OPTION
NO_INTEGER_OPTION:
print "You haven't passed the option '--integer'. This is fine with me.\n"
END_INTEGER_OPTION:
# For some reason I can't shift from argv
.local string other_arg
.local int cnt_other_args
cnt_other_args = 0
.local int num_other_args
num_other_args = argv
goto CHECK_OTHER_ARG_LOOP
REDO_OTHER_ARG_LOOP:
other_arg = argv[cnt_other_args]
print "You have passed the additional argument: '"
print other_arg
print "'.\n"
inc cnt_other_args
CHECK_OTHER_ARG_LOOP:
if cnt_other_args < num_other_args goto REDO_OTHER_ARG_LOOP
print "All args have been parsed.\n"
end
.end
# A dummy implementation of Getopt::Long
.include "library/Getopt/Long.imc"
CODE
getopt_long.t 0.01
This is just a test.
You have passed the option '--bool'.
You have passed the option '--string'. The value is 'asdf'.
You have passed the option '--integer'. The value is '42'.
You have passed the additional argument: 'some'.
You have passed the additional argument: 'thing'.
All args have been parsed.
OUT
=back
=head1 AUTHOR
Bernhard Schmalhofer <[EMAIL PROTECTED]>
=head1 SEE ALSO
F<runtime/parrot/library/Getopt/Long.imc>
1.7 +4 -4 parrot/examples/assembly/getopt_demo.imc
Index: getopt_demo.imc
===================================================================
RCS file: /cvs/public/parrot/examples/assembly/getopt_demo.imc,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- getopt_demo.imc 26 May 2004 08:51:04 -0000 1.6
+++ getopt_demo.imc 28 Oct 2004 09:43:04 -0000 1.7
@@ -1,5 +1,5 @@
# Copyright (C) 2001-2003 The Perl Foundation. All rights reserved.
-# $Id: getopt_demo.imc,v 1.6 2004/05/26 08:51:04 jrieks Exp $
+# $Id: getopt_demo.imc,v 1.7 2004/10/28 09:43:04 leo Exp $
=head1 NAME
@@ -27,11 +27,11 @@
=cut
.sub _main
- .param PerlArray argv
+ .param pmc argv
# Assemble specification for get_options
# in an array of format specifiers
- .local PerlArray opt_spec
+ .local ResizableStringArray opt_spec
opt_spec = new PerlArray
# --version, boolean
push opt_spec, "version"
@@ -50,7 +50,7 @@
# Make a copy of argv, because this can easier be handled in get_options()
# TODO: remove need for cloning
- .local PerlArray argv_clone
+ .local pmc argv_clone
argv_clone = clone argv
.local pmc opt
1.4 +37 -10 parrot/runtime/parrot/library/Getopt/Long.imc
Index: Long.imc
===================================================================
RCS file: /cvs/public/parrot/runtime/parrot/library/Getopt/Long.imc,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- Long.imc 23 Sep 2004 08:38:08 -0000 1.3
+++ Long.imc 28 Oct 2004 09:43:04 -0000 1.4
@@ -1,12 +1,39 @@
-# $Id: Long.imc,v 1.3 2004/09/23 08:38:08 leo Exp $
+# $Id: Long.imc,v 1.4 2004/10/28 09:43:04 leo Exp $
=head1 NAME
-library/Getopt/Long.imc - parse command line options
+library/Getopt/Long.imc - parse long and short command line options
=head1 SYNOPSIS
-See examples/assembly/getopt_demo.imc
+ # Assemble option specification
+ .local pmc opt_spec
+ opt_spec = new ResizableStringArray
+ push opt_spec, "bool"
+ push opt_spec, "string=s"
+ push opt_spec, "integer=i"
+
+ # the program name is the first element in argv
+ .local string program_name
+ program_name = shift argv
+
+ # Make a copy of argv, because this can easier be handled in get_options()
+ .local pmc argv_clone
+ argv_clone = clone argv
+
+ # Parse the command line params
+ .local pmc opt
+ ( opt ) = _get_options( argv_clone, opt_spec )
+
+ .local int is_defined
+ is_defined = defined opt["bool"]
+
+ .local int integer
+ integer = opt["integer"]
+
+ .local string s
+ s = opt["string"]
+
=head1 DESCRIPTION
@@ -25,19 +52,18 @@
=cut
.sub _get_options prototyped
- .param PerlArray argv
- .param PerlArray spec
+ .param pmc argv
+ .param pmc spec
# Loop over the array spec and build up two simple hashes
- .local pmc type # the type of the option: binary, string, integer
+ .local pmc type # the type of the option: binary, string,
integer
type = new PerlHash
- .local int curr_spec # a counter for looping over the array 'spec'
+ .local int curr_spec # a counter for looping over the array 'spec'
curr_spec = 0
.local int max_spec # for end condition of loop over 'spec'
max_spec = spec
.local int spec_index # searching for patterns in 'spec'
- .local string opt_name # name of specified option
- .local string opt_type # tyep of specified option
+ .local string opt_name, opt_type # name and type of specified option
goto CHECK_PARSE_SPEC
NEXT_PARSE_SPEC: # Look at next element in 'spec'
opt_name = spec[curr_spec]
@@ -146,11 +172,12 @@
=head1 AUTHOR
-Bernhard Schmalhofer - L<[EMAIL PROTECTED]>
+Bernhard Schmalhofer - L<[EMAIL PROTECTED]>
=head1 SEE ALSO
The Perl5 module L<Getopt::Long>.
+F<examples/assembly/getopt_demo.imc
=head1 COPYRIGHT