File Coverage

File:config/auto/sizes.pm
Coverage:97.1%

linestmtbrancondsubcode
1# Copyright (C) 2001-2003, Parrot Foundation.
2
3 - 11
=head1 NAME

config/auto/sizes.pm - Various Sizes

=head1 DESCRIPTION

Determines the sizes of various types.

=cut
12
13package auto::sizes;
14
15
2
2
2
2
use strict;
16
2
2
2
2
use warnings;
17
18
2
2
2
2
use base qw(Parrot::Configure::Step);
19
20
2
2
2
2
use Parrot::Configure::Utils ':auto';
21
22
23sub _init {
24
2
2
    my $self = shift;
25
2
    my %data;
26
2
    $data{description} = q{Determine some sizes};
27
2
    $data{result} = q{};
28
2
    return \%data;
29}
30
31sub runstep {
32
1
1
    my ( $self, $conf ) = @_;
33
34
1
    my %types = (
35        intval => $conf->data->get('iv'),
36        numval => $conf->data->get('nv'),
37        opcode => $conf->data->get('opcode_t'),
38        short => 'short',
39        int => 'int',
40        long => 'long',
41        longlong => 'long long',
42        ptr => 'void *',
43        float => 'float',
44        double => 'double',
45        longdouble => 'long double',
46    );
47
48
11
    my %sizes = map {
49
1
        $_, test_size($conf, $types{$_})
50    } keys %types;
51
52
1
    for ( keys %sizes ) {
53
11
        $conf->data->set( $_ . 'size' => $sizes{$_} );
54    }
55
56
1
    _handle_intval_ptrsize_discrepancy(\%sizes);
57
1
    _handle_longlong($conf, \%sizes);
58
59    # probe for 64-bit integer-types
60
1
    foreach my $type ('int64_t', '__int64') {
61
1
        my $size = test_size($conf, $type);
62
1
50
        if ($size) {
63
1
            $types{int64} = $type;
64
1
            $sizes{int64} = $size;
65
1
            last;
66        }
67    }
68
69    # set fixed sized types
70
1
    _set_int2($conf, \%types, \%sizes);
71
72
1
    _set_int4($conf, \%types, \%sizes);
73
74
1
    _set_int8($conf, \%types, \%sizes);
75
76
1
    _set_float4($conf, \%types, \%sizes);
77
78
1
    _set_float8($conf, \%types, \%sizes);
79
80    # get HUGEINTVAL
81
1
    my $hiv = do {
82
1
        my @t = ('long', 'int', 'longlong', 'int64', 'invtal');
83
1
        my $i = maxind( @sizes{grep exists $sizes{$_}, @t} );
84
1
        $t[$i];
85    };
86
87
1
    $conf->data->set(
88        hugeintval => $types{$hiv},
89        hugeintvalsize => $sizes{$hiv},
90    );
91
92    # get HUGEFLOATVAL
93
1
    my $hfv = do {
94
1
        my @t = ('float', 'double', 'longdouble', 'numval');
95
1
        my $i = maxind( @sizes{@t} );
96
1
        $t[$i];
97    };
98
99
1
    $conf->data->set(
100        hugefloatval => $types{$hfv},
101        hugefloatvalsize => $sizes{$hfv},
102    );
103
104
1
    _set_intvalmaxmin($conf);
105
106
1
    _set_floatvalmaxmin($conf);
107
108
1
    return 1;
109}
110
111#################### INTERNAL SUBROUTINES ####################
112
113sub test_size {
114
12
12
    my ($conf, $type) = @_;
115
116
12
    $conf->data->set( TEMP_type => $type );
117
12
    $conf->cc_gen('config/auto/sizes/test_c.in');
118
12
12
    eval { $conf->cc_build() };
119
12
50
    my $ret = $@ ? 0 : eval $conf->cc_run();
120
12
    $conf->cc_clean();
121
122
12
    return $ret;
123}
124
125sub maxind {
126
2
2
    my $i = 0;
127
2
67
    $_[$_] <= $_[$i] or $i = $_ for 0..$#_;
128
2
    return $i;
129}
130
131sub _handle_intval_ptrsize_discrepancy {
132
3
3
    my $sizesref = shift;
133
3
100
    if ( $sizesref->{ptr} != $sizesref->{intval} ) {
134
1
        print <<"END";
135
136Hmm, I see your chosen INTVAL isn't the same size as your pointers. Parrot
137should still compile and run, but you may see a ton of warnings.
138END
139    }
140}
141
142sub _handle_longlong {
143
1
1
    my ($conf, $sizesref) = @_;
144
1
    $conf->data->set( HAS_LONGLONG => !!($sizesref->{longlong} > 0) );
145}
146
147sub _set_int2 {
148
3
3
    my ($conf, $typesref, $sizesref) = @_;
149
3
100
    if ( $sizesref->{short} == 2 ) {
150
2
        $conf->data->set( int2_t => 'short' );
151    }
152    else {
153
1
        $conf->data->set( int2_t => 'int' );
154
1
        print <<'END';
155
156Can't find a int type with size 2, conversion ops might fail!
157
158END
159    }
160}
161
162sub _set_int4 {
163
5
5
    my ($conf, $typesref, $sizesref) = @_;
164
5
    foreach my $type (qw[ short int long ]) {
165
11
100
        if ( $sizesref->{$type} == 4 ) {
166
4
            $conf->data->set( int4_t => $typesref->{$type} );
167
4
            return;
168        }
169    }
170
171
1
    $conf->data->set( int4_t => 'int' );
172
1
    print <<'END';
173
174Can't find a int type with size 4, conversion ops might fail!
175
176END
177}
178
179sub _set_int8 {
180
1
1
    my ($conf, $typesref, $sizesref) = @_;
181
1
    foreach my $type (qw[ int long longlong int64 ]) {
182
3
100
        if ( $sizesref->{$type} == 8 ) {
183
1
            $conf->data->set(
184                int8_t => $typesref->{$type},
185                HAS_INT64 => 1,
186            );
187
1
            return;
188        }
189    }
190
191
0
    $conf->data->set( HAS_INT64 => 0 );
192
0
    print <<'END';
193
194Can't find an int type with size 8, 64-bit support dissabled.
195
196END
197}
198
199sub _set_float4 {
200
3
3
    my ($conf, $typesref, $sizesref) = @_;
201
3
100
    if ( $sizesref->{float} == 4 ) {
202
2
        $conf->data->set( float4_t => 'float' );
203    }
204    else {
205
1
        $conf->data->set( float4_t => 'double' );
206
1
        print <<'END';
207
208Can't find a float type with size 4, conversion ops might fail!
209
210END
211    }
212}
213
214sub _set_float8 {
215
3
3
    my ($conf, $typesref, $sizesref) = @_;
216
3
100
    if ( $sizesref->{double} == 8 ) {
217
2
        $conf->data->set( float8_t => 'double' );
218    }
219    else {
220
1
        $conf->data->set( float8_t => 'double' );
221
1
        print <<'END';
222
223Can't find a float type with size 8, conversion ops might fail!
224
225END
226    }
227}
228
229sub _set_intvalmaxmin {
230
7
7
    my $conf = shift;
231
7
    my $ivmin;
232
7
    my $ivmax;
233
7
    my $iv = $conf->data->get(qw(iv));
234
235
7
100
100
100
100
100
    if ( $iv eq "int" ) {
236
1
        $ivmin = 'INT_MIN';
237
1
        $ivmax = 'INT_MAX';
238    }
239    elsif ( ( $iv eq "long" ) || ( $iv eq "long int" ) ) {
240
3
        $ivmin = 'LONG_MIN';
241
3
        $ivmax = 'LONG_MAX';
242    }
243    elsif ( ( $iv eq "long long" ) || ( $iv eq "long long int" ) ) {
244        # The assumption is that a compiler that have the long long type
245        # also provides his limit macros.
246
2
        $ivmin = 'LLONG_MIN';
247
2
        $ivmax = 'LLONG_MAX';
248    }
249    else {
250
1
        die qq{Configure.pl: Cannot find limits for type '$iv'\n};
251    }
252
253
6
    $conf->data->set( intvalmin => $ivmin );
254
6
    $conf->data->set( intvalmax => $ivmax );
255}
256
257sub _set_floatvalmaxmin {
258
4
4
    my $conf = shift;
259
4
    my $nvmin;
260
4
    my $nvmax;
261
4
    my $nv = $conf->data->get(qw(nv));
262
263
4
100
100
    if ( $nv eq "double" ) {
264
2
        $nvmin = 'DBL_MIN';
265
2
        $nvmax = 'DBL_MAX';
266    }
267    elsif ( $nv eq "long double" ) {
268
269        # Stay way from long double for now (it may be 64 or 80 bits)
270        # die "long double not supported at this time, use double.";
271
1
        $nvmin = 'LDBL_MIN';
272
1
        $nvmax = 'LDBL_MAX';
273    }
274    else {
275
1
        die qq{Configure.pl: Cannot find limits for type '$nv'\n};
276    }
277
278
3
    $conf->data->set( floatvalmin => $nvmin );
279
3
    $conf->data->set( floatvalmax => $nvmax );
280}
281
2821;
283
284# Local Variables:
285# mode: cperl
286# cperl-indent-level: 4
287# fill-column: 100
288# End:
289# vim: expandtab shiftwidth=4: