cvsuser 05/03/28 04:22:00
Modified: classes pmc2c2.pl
examples/assembly md5sum.imc
runtime/parrot/library/Digest MD5.imc
t/library md5.t
Log:
[perl #34592] [PATCH] Small updates to parrot MD5 library
This patch makes some small cosmetic changes to the md5 library, harness
and tests (comments and formatting).
There's also a new test on a long string.
Courtesy of Nick Glencross <[EMAIL PROTECTED]>
---------
[perl #34576] [PATCH] more pmc2c2.pl work
This patch (a) adds comments before each subroutine describing its
parameters, its return values, and what it does, and (b) allows
unbalanced {} to be used inside of strings and comments in PMC code.
Courtesy of Matt Diephouse <[EMAIL PROTECTED]>
Revision Changes Path
1.29 +125 -21 parrot/classes/pmc2c2.pl
Index: pmc2c2.pl
===================================================================
RCS file: /cvs/public/parrot/classes/pmc2c2.pl,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- pmc2c2.pl 27 Mar 2005 23:12:43 -0000 1.28
+++ pmc2c2.pl 28 Mar 2005 12:21:53 -0000 1.29
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
-# $Id: pmc2c2.pl,v 1.28 2005/03/27 23:12:43 chromatic Exp $
+# $Id: pmc2c2.pl,v 1.29 2005/03/28 12:21:53 leo Exp $
=head1 NAME
@@ -257,6 +257,12 @@
main();
+#
+# my $path = find_file( [$dir1, $dir2], $file, $die_unless_found_flag );
+#
+# Return the full path to $file (search in the given directories).
+# Optionally, die with an error message if that file cannot be found.
+#
sub find_file {
my ($include, $file, $die_unless_found) = @_;
@@ -271,6 +277,12 @@
undef;
}
+#
+# dump_default();
+#
+# Create a .dump file for the default vtable (from which all PMCs
+# inherit).
+#
sub dump_default {
my $file = "$FindBin::Bin/../vtable.tbl";
my $default = parse_vtable($file);
@@ -306,28 +318,51 @@
close VTD;
}
+#
+# my ($balanced, $remaining) = extract_balanced($code);
+#
+# Remove a balanced {} construct from the beginning of $code.
+# Return it and the remaining code.
+#
sub extract_balanced {
+ my $code = shift;
my $balance = 0;
- my $lines = 0;
- for(shift) {
- s/^(\s+)//;
- $lines += count_newlines($1);
- /^\{/ or die "bad block open: ".substr($_,0,10),"..."; # }
-
- while(/ (\{) | (\}) /gx) {
- if($1) {
- $balance++;
- } else { # $2
- $balance--;
- return substr($_, 0, pos, ""), $_, $lines
- if not $balance;
- }
+ $code =~ s/^\s+//;
+
+ # create a copy and remove strings and comments so that
+ # unbalanced {} can be used in them in PMCs, being careful to
+ # preserve string length.
+ local $_ = $code;
+ s[
+ ( ' (?: \\. | [^'] )* ' # remove ' strings
+ | " (?: \\. | [^"] )* " # remove " strings
+ | /\* .*? \*/ ) # remove C comments
+ ]
+ [ "-" x length $1 ]sexg;
+
+ /^\{/ or die "bad block open: ", substr($code,0,10), "...";
+
+ while (/ (\{) | (\}) /gx) {
+ if($1) {
+ $balance++;
+ } else { # $2
+ $balance--;
+ return substr($code, 0, pos, ""), $code
+ if not $balance;
}
- die "Badly balanced" if $balance;
}
+ die "Badly balanced" if $balance;
}
+#
+# my ($pre, $class_name, $flags) = parse_flags(\$code);
+#
+# Extract a class signature from the code ref and return (a) the
+# code found before the signature, (b) the name of the class, and
+# (c) a hash ref containing the flags associated with the class
+# (such as 'extends' and 'does').
+#
sub parse_flags {
my $c = shift;
@@ -362,6 +397,12 @@
return $pre, $classname, \%flags;
}
+#
+# my ($name, $attributes) = parse_pmc($code);
+#
+# Parse PMC code and return the class name and a hash ref of
+# attributes.
+#
sub parse_pmc {
my $code = shift;
@@ -381,8 +422,8 @@
\( ([^\(]*) \) #parameters
}sx;
- my ($pre, $classname, $flags) = parse_flags(\$code);
- my ($classblock, $post, $lines) = extract_balanced($code);
+ my ($pre, $classname, $flags) = parse_flags(\$code);
+ my ($classblock, $post) = extract_balanced($code);
my $lineno = 1 + count_newlines($pre);
$classblock = substr($classblock, 1,-1); # trim out the { }
@@ -392,8 +433,7 @@
while ($classblock =~ s/($signature_re)//) {
$lineno += count_newlines($1);
my ($flag, $type, $methodname, $parameters) = ($2,$3,$4,$5);
- my ($methodblock, $rema, $lines) = extract_balanced($classblock);
- $lineno += $lines;
+ my ($methodblock, $rema) =
extract_balanced($classblock);
$methodblock = "" if $opt{nobody};
if ($methodname eq 'class_init') {
@@ -440,7 +480,13 @@
};
}
-# make a linear list of class->{parents} array
+#
+# gen_parent_list( [$dir1, $dir2], $class, $classes );
+#
+# Generate an ordered list of parent classes to put in the
+# $classes->{class}->{parents} array, using the given directories
+# to find parents.
+#
sub gen_parent_list {
my ($include, $this, $all) = @_;
@@ -469,6 +515,11 @@
}
+#
+# my $class = dump_1_pmc($file);
+#
+# Generate the class structure from $file for a .dump file.
+#
sub dump_1_pmc {
my $file = shift;
$file =~ s/\.\w+$/.pmc/;
@@ -480,6 +531,12 @@
return parse_pmc($contents);
}
+#
+# gen_super_meths($class, $vtable)
+#
+# Generate a list of inherited methods for $class by searching the
+# inheritence tree. The method list is found in $vtable.
+#
sub gen_super_meths {
my ($self, $vt) = @_;
@@ -512,6 +569,13 @@
}
}
+#
+# add_defaulted($class_structure, $vtable);
+#
+# Add methods to the class structure for each method found in the
+# vtable. This is used to determine all of the 'default' methods
+# from the vtable.dump.
+#
sub add_defaulted {
my ($class, $vt) = @_;
@@ -521,6 +585,13 @@
}
}
+#
+# my $newer = dump_is_newer($file);
+#
+# Return whether the dump of a file is newer than the PMC file.
+# (If it's not, then the PMC file has changed and the dump has
+# not been updated.)
+#
sub dump_is_newer {
my $pmc = my $file = shift;
$pmc =~ s/\.\w+$/.pmc/;
@@ -531,6 +602,13 @@
return $dump_dt > $pmc_dt;
}
+#
+# dump_pmc( [$dir1, $dir2], $file1, $file2, ... );
+#
+# Create a .dump file for each of the passed files (which can be
+# found in the given directories). A '*.pmc' glob may also be passed
+# to emulate a proper shell in the presence of a dump one.
+#
sub dump_pmc {
my ($include, @files) = @_;
# help these dumb 'shells' that are no shells
@@ -571,6 +649,12 @@
}
}
+#
+# my $class = read_dump( [$dir1, $dir2], $file );
+#
+# Read in the class definition found in $file (which is found in one
+# of the given directories) and recreate the data structure.
+#
sub read_dump {
my ($include, $file) = @_;
@@ -588,6 +672,14 @@
$class;
}
+#
+# print_tree( [$dir1, $dir2], 0, $file1, $file2, ... );
+#
+# Print the inheritence tree for each of the files, using the
+# given directories to search for all of correct PMCs. The middle
+# argument is the display depth, which is used for the recursive
+# definition of this function.
+#
sub print_tree {
my ($include,$depth, @files) = @_;
@@ -600,6 +692,12 @@
}
}
+#
+# gen_c( [$dir1, $dir2], $file1, $file2, ... );
+#
+# Generate the c source code file for each of the files passed in,
+# using the directories passed in to search for the PMC dump files.
+#
sub gen_c {
my ($include, @files) = @_;
my %pmcs = map { $_, read_dump($include, $_) } @files;
@@ -609,6 +707,12 @@
->write_all_files;
}
+#
+# main()
+#
+# Get and set the correct options and execute the runmode
+# specified in @ARGS.
+#
sub main {
my ($default, $dump, $gen_c, $tree, @include);
# initialization to prevent warnings
1.2 +8 -6 parrot/examples/assembly/md5sum.imc
Index: md5sum.imc
===================================================================
RCS file: /cvs/public/parrot/examples/assembly/md5sum.imc,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- md5sum.imc 22 Mar 2005 10:15:40 -0000 1.1
+++ md5sum.imc 28 Mar 2005 12:21:55 -0000 1.2
@@ -1,7 +1,7 @@
# Parrot md5sum; Nick Glencross <[EMAIL PROTECTED]>
+# Improvements from Leo
#
-# Based on md5.c, from md5sum
-# written by Ulrich Drepper <[EMAIL PROTECTED]>, 1995.
+# Harness for the library/Digest/MD5.imc library
=head1 NAME
@@ -15,17 +15,19 @@
Behave very much like md5sum(1).
+Running parrot with -j will give a significant performance boost (often
+about ten-fold).
+
=cut
###########################################################################
-
-# Main Harness to show that it works
+# Main Harness to demonstrate MD5.imc
.sub _main @MAIN
.param pmc args
- .local int size
+ .local int size
load_bytecode "library/Digest/MD5.imc"
# Argument count
$I0 = args
@@ -46,7 +48,7 @@
if $I1 > $I0 goto iter_done
$S0 = args[$I1]
.include "stat.pasm"
- # get size of file
+ # Get size of file
stat size, $S0, .STAT_FILESIZE
open $P0, $S0, "<"
defined $I2, $P0
1.2 +10 -12 parrot/runtime/parrot/library/Digest/MD5.imc
Index: MD5.imc
===================================================================
RCS file: /cvs/public/parrot/runtime/parrot/library/Digest/MD5.imc,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- MD5.imc 22 Mar 2005 10:15:42 -0000 1.1
+++ MD5.imc 28 Mar 2005 12:21:59 -0000 1.2
@@ -1,4 +1,5 @@
# Parrot md5sum; Nick Glencross <[EMAIL PROTECTED]>
+# Improvements from Leo
#
# Based on md5.c, from md5sum
# written by Ulrich Drepper <[EMAIL PROTECTED]>, 1995.
@@ -36,7 +37,7 @@
=item * Might work on 64 bit platforms
-=item * Might not work on big endian systems
+=item * Might not work on big endian systems (confirmed)
=back
@@ -95,6 +96,7 @@
_md5_process_buffer (context, buffer)
.return(context)
+
.end
@@ -275,7 +277,7 @@
shift = 8*subcounter
word = word << shift
if endian goto endian_ok2
- .swap (word)
+ .swap (word)
endian_ok2:
buffer[slow_counter] = word
@@ -300,15 +302,8 @@
.param pmc context
.param pmc buffer
- .local int A
- .local int B
- .local int C
- .local int D
-
- .local int A_save
- .local int B_save
- .local int C_save
- .local int D_save
+ .local int A, B, C, D
+ .local int A_save, B_save, C_save, D_save
.local int tmp, idx, len
@@ -413,7 +408,7 @@
context[2] = C
context[3] = D
- # _print_vals (A,B,C,D)
+ # print_vals (A,B,C,D)
# print "\n"
.end
@@ -470,6 +465,7 @@
dont_swap:
_print_vals (A,B,C,D)
+
.end
###########################################################################
@@ -501,6 +497,7 @@
print_buffer_done:
print "\n"
+
.end
###########################################################################
@@ -523,4 +520,5 @@
sprintf $S0, $S1, $P0
.return($S0)
+
.end
1.2 +26 -3 parrot/t/library/md5.t
Index: md5.t
===================================================================
RCS file: /cvs/public/parrot/t/library/md5.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- md5.t 22 Mar 2005 10:15:44 -0000 1.1
+++ md5.t 28 Mar 2005 12:22:00 -0000 1.2
@@ -6,19 +6,22 @@
# $ echo -n Hello World! | md5sum
# a0f32c7d31302c1427285b1a0fcbb015 -
+# As well as testing the MD5 library itself, it is useful for spotting
+# regressisions in the parrot VM, JIT and GC
+
use strict;
-use Parrot::Test tests => 3;
+use Parrot::Test tests => 4;
use Parrot::Config;
-my $bigendian = $PConfig{bigendian};
my $intsize = $PConfig{intsize};
+my $bigendian = $PConfig{bigendian};
SKIP: {
if ($bigendian || $intsize != 4)
{
- skip('MD5 only known to work on small endian 32 bit processors', 3)
+ skip('MD5 only known to work on small endian 32 bit processors', 4)
}
@@ -53,6 +56,8 @@
ed076287532e86365e841e92bfc50d8c
OUT
+
+
pir_output_is(<<'CODE', <<'OUT', "Funny chars");
.sub _main
load_bytecode "library/Digest/MD5.imc"
@@ -78,6 +83,7 @@
;
}
(
+ "",
"0",
"01",
"012",
@@ -200,6 +206,7 @@
end
.end
CODE
+d41d8cd98f00b204e9800998ecf8427e
cfcd208495d565ef66e7dff9f98764da
96a3be3cf272e017046d1b2674a52bd3
d2490f048dc3b77a457e3e450ab4eb38
@@ -312,4 +319,20 @@
09e32555adc12a6f2c8fed9a459935af
6c27622d1d5365e4abfd02f2eccfd8f9
OUT
+
+
+my $text = "Hello Parrot World! " x 50_000;
+
+pir_output_is(<<CODE, <<'OUT', "REALLY long string");
+.sub _main
+ load_bytecode "library/Digest/MD5.imc"
+ \$P0 = _md5sum ("$text")
+ _md5_print (\$P0)
+ print "\\n"
+ end
+.end
+CODE
+840e4dec51660b1f52473e0b0b9545f5
+OUT
+
}
