Index: parrot-svn/lib/Parrot/BuildUtil.pm =================================================================== --- parrot-svn.orig/lib/Parrot/BuildUtil.pm +++ parrot-svn/lib/Parrot/BuildUtil.pm @@ -12,9 +12,9 @@ Parrot::BuildUtil - Utilities for buildi =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,60 @@ END_HEADER return $header; } -1; +=item C -=back +Generate a unique number, the md5 of F, +for each pbc format change. The length (12) influences +the header layout. + +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 $content = slurp_file('PBC_COMPAT'); + $content =~ s/^#.*\n//gm; + $content =~ s/^\n//gm; + my $fingerprint = Digest::MD5::md5($content); + return substr $fingerprint, 0, 12; +} + +=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 +++ parrot-svn/tools/dev/pbc_header.pl @@ -36,28 +36,14 @@ headers. =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; 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"; @@ -87,7 +73,8 @@ sub get_bc_version { sub update_fp { my (@args) = @_; - my $fp = get_fp(); + my $fp = Parrot::BuildUtil::generate_pbc_fingerprint(); + my $fp_len = length $fp; my ( $major, $minor, $patch ) = get_version(); my ( $bc_major, $bc_minor ) = get_bc_version(); for my $f (@args) { @@ -104,12 +91,12 @@ sub update_fp { # 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 +106,7 @@ sub update_fp { } 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 +++ parrot-svn/config/gen/config_h/config_h.in @@ -94,6 +94,7 @@ struct PackFile; typedef struct Pac #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 +++ parrot-svn/src/packfile.c @@ -1245,6 +1245,15 @@ PackFile_set_header(ARGOUT(PackFile_Head # endif # endif #endif + if (*PARROT_PBC_UUID) { + header->uuid_type = 1; + header->uuid_size = sizeof(PARROT_PBC_UUID); + header->uuid_data = (unsigned char *)PARROT_PBC_UUID; + 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; + } } Index: parrot-svn/Configure.pl =================================================================== --- parrot-svn.orig/Configure.pl +++ parrot-svn/Configure.pl @@ -64,8 +64,9 @@ $conf->add_steps( @{ $steps_list_ref } ) # 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 +++ parrot-svn/config/auto/pmc.pm @@ -9,6 +9,9 @@ config/auto/pmc.pm - PMC Files 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::Basename qw/basename/; use File::Spec::Functions qw/catfile/; use Parrot::Configure::Utils ':auto'; +use Parrot::BuildUtil; sub _init { my $self = shift; @@ -168,9 +172,28 @@ PMC: for my $pmc_file ( split( /\s+/, $p 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 $ops = $conf->data->get( 'ops' ); + my $fp = join( ' ', @names ) . " ". $ops . " " . $major . " " . $minor; + $pbc_uuid = substr Digest::MD5::md5( $fp ), 0, 12; + } + } + 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 +++ parrot-svn/tools/build/pbcversion_h.pl @@ -21,28 +21,15 @@ them in a header file. 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 +++ parrot-svn/config/auto/ops.pm @@ -9,6 +9,8 @@ config/auto/ops.pm - Ops Files 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;