config/auto/pack.pm

   1 # Copyright (C) 2001-2008, The Perl Foundation.
   2 # $Id$
   3
   4 =head1 NAME
   5
   6 config/auto/pack.pm - Packing
   7
   8 =head1 DESCRIPTION
   9
  10 Figures out how to C<pack()> Parrot's types.
  11
  12 =cut
  13
  14 package auto::pack;
  15
  16 use strict;
  17 use warnings;
  18
  19 use base qw(Parrot::Configure::Step);
  20
  21 sub _init {
  22     my $self = shift;
  23
  24     return { description => q{Figuring out how to pack() Parrot's types},
  25              result      => q{},
  26            };
  27 }
  28
  29 sub runstep {
  30     my ( $self, $conf ) = @_;
  31
  32     #
  33     # Alas perl5.7.2 doesn't have an INTVAL flag for pack().
  34     # The ! modifier only works for perl 5.6.x or greater.
  35     #
  36
  37     my $intsize  = $conf->data->get('intsize');
  38     my $longsize = $conf->data->get('longsize');
  39     my $ptrsize  = $conf->data->get('ptrsize');
  40
  41     foreach ( 'intvalsize', 'opcode_t_size' ) {
  42         my $which = $_ eq 'intvalsize' ? 'packtype_i' : 'packtype_op';
  43         my $size = $conf->data->get($_);
  44         my $format;
  45         if (    $size == $longsize
  46              && $size == $conf->data->get_p5('longsize')
  47            ) {
  48             $format = 'l!';
  49         }
  50         elsif ( $size == 4 ) {
  51             $format = 'l';
  52         }
  53         elsif (    $size == 8
  54                 || $conf->data->get_p5('use64bitint') eq 'define'
  55               ) {
  56             # pp_pack is annoying, and this won't work unless sizeof(UV) >= 8
  57             $format = 'q';
  58         }
  59         warn "Configure.pl:  Unable to find a suitable packtype for $_.\n"
  60             unless $format;
  61
  62         my $test = eval { pack $format, 0 };
  63         unless ( defined $test ) {
  64             warn <<"AARGH"
  65 Configure.pl:  Unable to find a functional packtype for $_.
  66                '$format' failed: $@
  67 AARGH
  68         }
  69         if ($test) {
  70             unless ( length $test == $size ) {
  71                 warn sprintf <<"AARGH", $size, length $test;
  72 Configure.pl:  Unable to find a functional packtype for $_.
  73                Need a format for %d bytes, but '$format' gave %d bytes.
  74 AARGH
  75             }
  76         }
  77         else {
  78             $format = '?';
  79         }
  80
  81         $conf->data->set( $which => $format );
  82     }
  83
  84     _set_packtypes($conf);
  85
  86     # Find out what integer constant type we can use
  87     # for pointers.
  88     _set_ptrconst($conf, $ptrsize, $intsize, $longsize);
  89
  90     return 1;
  91 }
  92
  93 sub _set_packtypes {
  94     my $conf = shift;
  95
  96     $conf->data->set(
  97         packtype_b => 'C',
  98         packtype_n => ( $conf->data->get('numvalsize') == 12 ? 'D' : 'd' )
  99     );
 100 }
 101
 102 sub _set_ptrconst {
 103     my ($conf, $ptrsize, $intsize, $longsize) = @_;
 104
 105     if ( $intsize == $ptrsize ) {
 106         $conf->data->set( ptrconst => "u" );
 107     }
 108     elsif ( $longsize == $ptrsize ) {
 109         $conf->data->set( ptrconst => "ul" );
 110     }
 111     else {
 112         warn <<"AARGH";
 113 Configure.pl:  Unable to find an integer type that fits a pointer.
 114 AARGH
 115     }
 116 }
 117
 118 1;
 119
 120 # Local Variables:
 121 #   mode: cperl
 122 #   cperl-indent-level: 4
 123 #   fill-column: 100
 124 # End:
 125 # vim: expandtab shiftwidth=4: