config/auto/sizes.pm

   1 # Copyright (C) 2001-2003, The Perl Foundation.
   2 # $Id$
   3
   4 =head1 NAME
   5
   6 config/auto/sizes.pm - Various Sizes
   7
   8 =head1 DESCRIPTION
   9
  10 Determines the sizes of various types.
  11
  12 =cut
  13
  14 package auto::sizes;
  15
  16 use strict;
  17 use warnings;
  18
  19 use base qw(Parrot::Configure::Step);
  20
  21 use Parrot::Configure::Utils ':auto';
  22
  23
  24 sub _init {
  25     my $self = shift;
  26     my %data;
  27     $data{description} = q{Determining some sizes};
  28     $data{result}      = q{};
  29     return \%data;
  30 }
  31
  32 sub runstep {
  33     my ( $self, $conf ) = @_;
  34
  35     if ( defined $conf->options->get('miniparrot') ) {
  36         $conf->data->set(
  37             doublesize       => 8,
  38             numvalsize       => 8,
  39             nvsize           => 8,
  40             floatsize        => 4,
  41             opcode_t_size    => 4,
  42             ptrsize          => 4,
  43             intvalsize       => 4,
  44             intsize          => 4,
  45             longsize         => 4,
  46             shortsize        => 2,
  47             hugeintval       => 'long',
  48             hugeintvalsize   => 4,
  49             hugefloatval     => 'double',
  50             hugefloatvalsize => 8,
  51             int2_t           => 'int',
  52             int4_t           => 'int',
  53             float4_t         => 'double',
  54             float8_t         => 'double',
  55         );
  56         $self->set_result('using miniparrot defaults');
  57         return 1;
  58     }
  59
  60     $conf->cc_gen('config/auto/sizes/test_c.in');
  61     $conf->cc_build();
  62     my %results = eval $conf->cc_run();
  63     $conf->cc_clean();
  64
  65     for ( keys %results ) {
  66         $conf->data->set( $_ => $results{$_} );
  67     }
  68
  69     _handle_intval_ptrsize_discrepancy(\%results);
  70
  71     # set fixed sized types
  72     _set_int2($conf, \%results);
  73
  74     _set_int4($conf, \%results);
  75
  76     _set_float4($conf, \%results);
  77
  78     _set_float8($conf, \%results);
  79
  80     my %hugeintval;
  81     my $intval     = $conf->data->get('iv');
  82     my $intvalsize = $conf->data->get('intvalsize');
  83
  84     # Get HUGEINTVAL, note that we prefer standard types
  85     foreach my $type ( 'long', 'int', 'long long', '__int64' ) {
  86
  87         $conf->data->set( int8_t => $type );
  88         eval {
  89             $conf->cc_gen('config/auto/sizes/test2_c.in');
  90             $conf->cc_build();
  91             %hugeintval = eval $conf->cc_run();
  92             $conf->cc_clean();
  93         };
  94
  95         # clear int8_t on error
  96         if ( $@ || !exists $hugeintval{hugeintval} ) {
  97             $conf->data->set( int8_t => undef );
  98             next;
  99         }
 100
 101         if ( $hugeintval{hugeintvalsize} > $intvalsize ) {
 102
 103             # We found something bigger than intval.
 104             $conf->data->set(%hugeintval);
 105             last;
 106         }
 107     }
 108     _handle_hugeintvalsize(
 109         $conf,
 110         {
 111             hugeintval      => \%hugeintval,
 112             intval          => $intval,
 113             intvalsize      => $intvalsize,
 114         },
 115     );
 116
 117     $conf->cc_clean();
 118
 119     #get HUGEFLOATVAL
 120     my $size = _probe_for_hugefloatval( $conf );
 121     _set_hugefloatval( $conf, $size );
 122
 123     $conf->cc_clean();
 124
 125     return 1;
 126 }
 127
 128 #################### INTERNAL SUBROUTINES ####################
 129
 130 sub _handle_intval_ptrsize_discrepancy {
 131     my $resultsref = shift;
 132     if ( $resultsref->{ptrsize} != $resultsref->{intvalsize} ) {
 133         print <<"END";
 134
 135 Hmm, I see your chosen INTVAL isn't the same size as your pointers.  Parrot
 136 should still compile and run, but you may see a ton of warnings.
 137 END
 138     }
 139 }
 140
 141 sub _set_int2 {
 142     my ($conf, $resultsref) = @_;
 143     if ( $resultsref->{shortsize} == 2 ) {
 144         $conf->data->set( int2_t => 'short' );
 145     }
 146     else {
 147         $conf->data->set( int2_t => 'int' );
 148         print <<'END';
 149
 150 Can't find a int type with size 2, conversion ops might fail!
 151
 152 END
 153     }
 154 }
 155
 156 sub _set_int4 {
 157     my ($conf, $resultsref) = @_;
 158     if ( $resultsref->{shortsize} == 4 ) {
 159         $conf->data->set( int4_t => 'short' );
 160     }
 161     elsif ( $resultsref->{intsize} == 4 ) {
 162         $conf->data->set( int4_t => 'int' );
 163     }
 164     elsif ( $resultsref->{longsize} == 4 ) {
 165         $conf->data->set( int4_t => 'long' );
 166     }
 167     else {
 168         $conf->data->set( int4_t => 'int' );
 169         print <<'END';
 170
 171 Can't find a int type with size 4, conversion ops might fail!
 172
 173 END
 174     }
 175 }
 176
 177 sub _set_float4 {
 178     my ($conf, $resultsref) = @_;
 179     if ( $resultsref->{floatsize} == 4 ) {
 180         $conf->data->set( float4_t => 'float' );
 181     }
 182     else {
 183         $conf->data->set( float4_t => 'double' );
 184         print <<'END';
 185
 186 Can't find a float type with size 4, conversion ops might fail!
 187
 188 END
 189     }
 190 }
 191
 192 sub _set_float8 {
 193     my ($conf, $resultsref) = @_;
 194     if ( $resultsref->{doublesize} == 8 ) {
 195         $conf->data->set( float8_t => 'double' );
 196     }
 197     else {
 198         $conf->data->set( float8_t => 'double' );
 199         print <<'END';
 200
 201 Can't find a float type with size 8, conversion ops might fail!
 202
 203 END
 204     }
 205 }
 206
 207 sub _handle_hugeintvalsize {
 208     my $conf = shift;
 209     my $arg = shift;
 210     if ( ! defined( $arg->{hugeintval}{hugeintvalsize} )
 211         || $arg->{hugeintval}{hugeintvalsize} == $arg->{intvalsize} )
 212     {
 213
 214         # Could not find anything bigger than intval.
 215         $conf->data->set(
 216             hugeintval     => $arg->{intval},
 217             hugeintvalsize => $arg->{intvalsize},
 218         );
 219     }
 220 }
 221
 222 sub _probe_for_hugefloatval {
 223     my $conf = shift;
 224     my $size = q{};
 225     $size = eval {
 226         open( my $TEST, ">", "test.c" ) or die "Can't open test.c: $!";
 227         print {$TEST} <<'END';
 228 #include <stdio.h>
 229
 230 int main() {
 231     long double foo;
 232     printf("%u", sizeof(foo));
 233     return 0;
 234 }
 235 END
 236         close $TEST;
 237
 238         $conf->cc_build();
 239         $conf->cc_run();
 240     };
 241 }
 242
 243 sub _set_hugefloatval {
 244     my ( $conf, $size ) = @_;
 245     if ( $size ) {
 246         $conf->data->set(
 247             hugefloatval     => 'long double',
 248             hugefloatvalsize => $size
 249         );
 250     }
 251     else {
 252         $conf->data->set(
 253             hugefloatval     => 'double',
 254             hugefloatvalsize => $conf->data->get('doublesize')
 255         );
 256     }
 257 }
 258
 259 1;
 260
 261 # Local Variables:
 262 #   mode: cperl
 263 #   cperl-indent-level: 4
 264 #   fill-column: 100
 265 # End:
 266 # vim: expandtab shiftwidth=4: