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
   
  
  
  

Reply via email to