[core] TT #359 implement pbc_uuid writing - pbc_uuid now binary safe, as md5_base64 size=23 - pbc_uuid is calculated in auto::pmc, after auto::ops. Two use-cases: 1) on user-defined pmc and ops take this name list, plus bc_major, bc_minor. 2) default: md5 of PBC_COMPAT - What should else should be taken into the uuid? I just have the pmc and ops names plus bc version, but in reality all the public interfaces are needed also. - Two generic pbc functions are moved to Parrot::BuildUtil, get_bc_version() and generate_pbc_fingerprint(). This simplifies dev/pbc_header.pl and tools/build/pbcversion_h.pl. - Added an exported Parrot_freeze_size, currently the same as Parrot_freeze, but should internally use VISIT_FREEZE_SIZE, not to malloc/free around like crazy. Missing: - warnings/errors on mismatches. - generate better a UUID, based on changed interfaces (configure-time), not a required change description in PBC_COMPAT. Index: parrot-svn/lib/Parrot/BuildUtil.pm =================================================================== --- parrot-svn.orig/lib/Parrot/BuildUtil.pm 2009-02-20 14:27:44.000000000 +0000 +++ parrot-svn/lib/Parrot/BuildUtil.pm 2009-02-20 14:28:28.015875000 +0000 @@ -12,9 +12,9 @@ =head1 DESCRIPTION -This package holds three subroutines: C, C, -and C. Subroutines are not exported--each must be -requested by using a fully qualified name. +This package holds pre-configure time subroutines, which are not exported +and should not require Parrot::Config. +Each must be requested by using a fully qualified name. =head1 SUBROUTINES @@ -134,13 +134,65 @@ return $header; } -1; +=item C -=back +Generate a unique number, the md5 of either the given arguments or +of the non-commented lines of F, for each pbc format change. + +This is used in the packfile library. +See also F + +=cut + +sub generate_pbc_fingerprint { + + unless (eval { require Digest::MD5; }) { + warn "Digest::MD5 not found. Skipping fingerprint"; + return ''; + } + my $uuid; + if (@_) { + $uuid = Digest::MD5::md5_base64(join " ", @_); + } + else { + my $content = slurp_file('PBC_COMPAT'); + $content =~ s/^#.*\n//gm; + $content =~ s/^\n//gm; + $uuid = Digest::MD5::md5_base64($content); + } + return substr $uuid, 0, 22; +} + +=item C + +Return an array of ($bc_major, $bc_minor) from F. +This is used to generate the pbc_uuid. -=head1 AUTHOR +See also F and F. -Gregor N. Purdy. Revised by James E Keenan. +=cut + +sub get_bc_version { + my $compat_file = 'PBC_COMPAT'; + my ( $bc_major, $bc_minor ); + open my $IN, '<', $compat_file or die "Can't read $compat_file"; + while (<$IN>) { + if (/^(\d+)\.0*(\d+)/) { + ( $bc_major, $bc_minor ) = ( $1, $2 ); + last; + } + } + unless ( defined $bc_major && defined $bc_minor ) { + die "No bytecode version found in '$compat_file'."; + } + close $IN; + return ( $bc_major, $bc_minor ); +} + + +1; + +=back =cut Index: parrot-svn/tools/dev/pbc_header.pl =================================================================== --- parrot-svn.orig/tools/dev/pbc_header.pl 2009-02-20 14:27:44.000000000 +0000 +++ parrot-svn/tools/dev/pbc_header.pl 2009-02-20 14:28:28.015875000 +0000 @@ -36,60 +36,21 @@ =cut use Getopt::Long; -use Digest::MD5 qw(md5); +use lib "lib"; +use Parrot::BuildUtil; my %opt; -use constant FP_LEN => 12; -my $word_size = 4; +my $word_size = 4; # fixed and not opcode_t_size ! main(); -sub get_fp { - - # s. also fingerprint_c.pl - my $compat_file = 'PBC_COMPAT'; - open my $IN, '<', $compat_file or die "Can't read $compat_file"; - my @lines = <$IN>; - close $IN; - - my $len = FP_LEN; - my $fingerprint = md5 join "\n", grep { !/^#/ } @lines; - - return substr $fingerprint, 0, $len; -} - -sub get_version { - my $version_file = 'VERSION'; - open my $IN, '<', $version_file or die "Can't read $version_file"; - my $v = <$IN>; - close $IN; - $v =~ /^(\d+)\.(\d+).?(\d+)?/; - my ($major, $minor, $patch) = ($1, $2, $3 ? $3 : 0); - die "Can't read $version_file" unless defined $major; - return ( $major, $minor, $patch ); -} - -sub get_bc_version { - my $compat_file = 'PBC_COMPAT'; - my ( $major, $minor ); - open my $IN, '<', $compat_file or die "Can't read $compat_file"; - while (<$IN>) { - if (/^(\d+)\.0*(\d+)/) { - ( $major, $minor ) = ( $1, $2 ); - last; - } - } - die "Can't read $compat_file" unless defined $major; - close $IN; - return ( $major, $minor ); -} - sub update_fp { my (@args) = @_; - my $fp = get_fp(); - my ( $major, $minor, $patch ) = get_version(); - my ( $bc_major, $bc_minor ) = get_bc_version(); + my $fp = Parrot::BuildUtil::generate_pbc_fingerprint(); + my $fp_len = length $fp; + my ( $major, $minor, $patch ) = Parrot::BuildUtil::parrot_version(); + my ( $bc_major, $bc_minor ) = Parrot::BuildUtil::get_bc_version(); for my $f (@args) { my $b; open my $F, "+<", "$f" or die "Can't open $f: $!"; @@ -104,12 +65,12 @@ # uuid_type = 1, uuid_size = 10, uuid_data = $fp read $F, $b, 8; my ($type, $uuid_len) = unpack "cc", $b; - if ($type != 1 or $uuid_len != FP_LEN) { + if ($type != 1 or $uuid_len != $fp_len) { # if uuid_type was 0 or of different size copy the tail first my $leftover = (18 + $uuid_len) % 16; my $n = $leftover == 0 ? 0 : 16 - $leftover; - # we can skip the copy if there's enough room already (pad:14=>2) - goto SEEK if $n < FP_LEN; + # we can skip the copy if there's enough room already (pad: 14=>2) + goto SEEK if $n > $fp_len; my $dirstart = 18 + $uuid_len + $n; seek $F, $dirstart, 0; # skip to dir my $size = -s $F; @@ -119,7 +80,7 @@ } SEEK: seek $F, 16, 0; # back to pos 16: uuid_type, uuid_size - print $F pack "cc", 1, FP_LEN; + print $F pack "cc", 1, $fp_len; print $F $fp; close $F; } Index: parrot-svn/config/gen/config_h/config_h.in =================================================================== --- parrot-svn.orig/config/gen/config_h/config_h.in 2009-02-20 14:27:44.000000000 +0000 +++ parrot-svn/config/gen/config_h/config_h.in 2009-02-20 14:28:28.015875000 +0000 @@ -94,6 +94,7 @@ #define PARROT_BYTEORDER 0x@byteorder@ #define PARROT_BIGENDIAN @bigendian@ #define PARROT_PTR_ALIGNMENT @ptr_alignment@ +#define PARROT_PBC_UUID "@pbc_uuid@" #define PARROT_LITTLEENDIAN !(PARROT_BIGENDIAN) Index: parrot-svn/src/packfile.c =================================================================== --- parrot-svn.orig/src/packfile.c 2009-02-20 14:27:44.000000000 +0000 +++ parrot-svn/src/packfile.c 2009-02-20 14:49:27.969000000 +0000 @@ -981,22 +981,22 @@ : FLOATTYPE_12_NAME)); TRACE_PRINTF(("PackFile_unpack: Byteorder %d (%sendian).\n", header->byteorder, header->byteorder ? "big " : "little-")); - + TRACE_PRINTF(("PackFile_unpack: uuid_type=%d\n", header->uuid_type)); + TRACE_PRINTF(("PackFile_unpack: uuid_size=%d\n", header->uuid_size)); /* Check the UUID type is valid and, if needed, read a UUID. */ if (header->uuid_type == 0) { /* No UUID; fine, nothing more to do. */ } else if (header->uuid_type == 1) { /* Read in the UUID. We'll put it in a NULL-terminated string, just in - * case pepole use it that way. */ + * case people use it that way. */ header->uuid_data = (unsigned char *) mem_sys_allocate(header->uuid_size + 1); - memcpy(header->uuid_data, packed + PACKFILE_HEADER_BYTES, - header->uuid_size); - + memcpy(header->uuid_data, PARROT_PBC_UUID, header->uuid_size); /* NULL terminate */ header->uuid_data[header->uuid_size] = 0; + TRACE_PRINTF(("PackFile_unpack: uuid_data='%s'\n", header->uuid_data)); } else /* Don't know this UUID type. */ @@ -1009,6 +1009,8 @@ header_read_length += header_read_length % 16 ? 16 - header_read_length % 16 : 0; cursor = packed + (header_read_length / sizeof (opcode_t)); + TRACE_PRINTF(("PackFile_unpack: pad=%d\n", + cursor - packed)); /* Set what transforms we need to do when reading the rest of the file. */ PackFile_assign_transforms(self); @@ -1244,6 +1246,14 @@ # endif # endif #endif + if (strlen(PARROT_PBC_UUID)) { + header->uuid_type = 1; + header->uuid_size = strlen(PARROT_PBC_UUID); + header->uuid_data = (unsigned char *)mem_sys_allocate(header->uuid_size + 1); + memcpy(header->uuid_data, PARROT_PBC_UUID, header->uuid_size); + /* NULL terminate */ + header->uuid_data[header->uuid_size] = 0; + } } @@ -3482,7 +3492,7 @@ ep->type = type; ep->name = name; - if (PackFile_map_segments(interp, dir, find_fixup_iter, (void *) ep)); + if (PackFile_map_segments(interp, dir, find_fixup_iter, (void *) ep)) return ep; return NULL; Index: parrot-svn/Configure.pl =================================================================== --- parrot-svn.orig/Configure.pl 2009-02-20 14:27:44.000000000 +0000 +++ parrot-svn/Configure.pl 2009-02-20 14:28:28.031500000 +0000 @@ -64,8 +64,9 @@ # from Parrot::Configure::Data $conf->options->set( %{$args} ); # save the command-line for make reconfig -$conf->data->set(configure_args => @ARGV ? '"'.join("\" \"", map {qq($_)} @ARGV).'"' - : ''); +$conf->data->set(configure_args => + @ARGV ? '"'.join("\" \"", map {qq($_)} @ARGV).'"' + : ''); # Log files created by Configure.pl in MANIFEST.configure.generated $conf->{active_configuration} = 1; Index: parrot-svn/config/auto/pmc.pm =================================================================== --- parrot-svn.orig/config/auto/pmc.pm 2009-02-20 14:27:44.000000000 +0000 +++ parrot-svn/config/auto/pmc.pm 2009-02-20 14:39:47.672125000 +0000 @@ -9,6 +9,9 @@ Asks the user to select which PMC files to include. +Generate a specific UUID for this selection then, +for the default use the md5 of PBC_COMPAT. + =cut package auto::pmc; @@ -22,6 +25,7 @@ use File::Spec::Functions qw/catfile/; use Parrot::Configure::Utils ':auto'; +use Parrot::BuildUtil; sub _init { my $self = shift; @@ -168,9 +172,29 @@ my @names = $self->order_pmcs_by_hierarchy( \%parents ); + # Generate a specific UUID for user-defined pmc's and ops + # auto::ops runs before auto::pmc, so do it here. + my $pbc_uuid = ''; + if ($conf->options->get('pmc') or $conf->options->get('ops')) { + unless (eval { require Digest::MD5; }) { + warn "Digest::MD5 not found. Skipping fingerprint"; + } + else { + my ( $major, $minor ) = Parrot::BuildUtil::get_bc_version(); + my @sources = (@names, $major, $minor); + my $ops = $conf->data->get( 'ops' ); + push @sources, $ops if $ops; + $pbc_uuid = Parrot::BuildUtil::generate_pbc_fingerprint(@sources); + } + } + else { # use the default UUID. This requires PBC_COMPAT discipline + $pbc_uuid = Parrot::BuildUtil::generate_pbc_fingerprint(); + } + $conf->data->set( pmc => $pmc_list, pmc_names => join( ' ', @names ), + pbc_uuid => $pbc_uuid, TEMP_pmc_o => $TEMP_pmc_o, TEMP_pmc_build => $TEMP_pmc_build, TEMP_pmc_classes_o => $TEMP_pmc_classes_o, Index: parrot-svn/tools/build/pbcversion_h.pl =================================================================== --- parrot-svn.orig/tools/build/pbcversion_h.pl 2009-02-20 14:27:44.000000000 +0000 +++ parrot-svn/tools/build/pbcversion_h.pl 2009-02-20 14:28:28.031500000 +0000 @@ -21,28 +21,15 @@ use warnings; use strict; use lib 'lib'; +use Parrot::BuildUtil; -my ( $major, $minor ); - -my $compat_file = 'PBC_COMPAT'; -open my $IN, '<', $compat_file or die "Can't read $compat_file"; -while (<$IN>) { - if (/^(\d+)\.0*(\d+)/) { - ( $major, $minor ) = ( $1, $2 ); - last; - } -} -close $IN; - -unless ( defined $major && defined $minor ) { - die "No bytecode version found in '$compat_file'."; -} +my ( $major, $minor ) = Parrot::BuildUtil::get_bc_version(); print << "EOF"; /* ex: set ro: * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! * - * This file is generated automatically from '$compat_file' + * This file is generated automatically from 'PBC_COMPAT' * by $0. * * Any changes made here will be lost! Index: parrot-svn/config/auto/ops.pm =================================================================== --- parrot-svn.orig/config/auto/ops.pm 2009-02-20 14:27:44.000000000 +0000 +++ parrot-svn/config/auto/ops.pm 2009-02-20 14:28:28.062750000 +0000 @@ -9,6 +9,8 @@ Asks the user to select which ops files to include. +Generate a specific UUID for this selection in auto::pmc then. + =cut package auto::ops;