package
rperltypessizes;
our
$VERSION
= 0.004_000;
package
string;
package
string_hashref;
package
rperltypessizes;
our
string_hashref
$ALTERNATE_TYPES_TO_PERLISH_TYPES
= {
'__int8'
=>
'i8'
,
'__int16'
=>
'i16'
,
'__int32'
=>
'i32'
,
'__int64'
=>
'i64'
,
'__int128'
=>
'i128'
,
'int8_t'
=>
'i8'
,
'int16_t'
=>
'i16'
,
'int32_t'
=>
'i32'
,
'int64_t'
=>
'i64'
,
'int128_t'
=>
'i128'
,
'long long'
=>
'longlong'
,
};
sub
type_integer_bitsize {
type_integer_errorcheck();
return
(
$Config
{ivsize} * 8);
}
sub
type_integer_native {
type_integer_errorcheck();
return
$Config
{ivtype};
}
sub
type_integer_native_ccflag {
type_integer_errorcheck();
my
string
$ivtype
=
$Config
{ivtype};
if
(
$ivtype
eq
'long'
) {
return
' -D__TYPE__INTEGER__LONG'
;
}
elsif
((
$ivtype
eq
'longlong'
) or (
$ivtype
eq
'long long'
)) {
return
' -D__TYPE__INTEGER__LONG'
;
}
elsif
(
$ivtype
eq
'__int8'
) {
return
' -D__TYPE__INTEGER____INT8'
;
}
elsif
(
$ivtype
eq
'__int16'
) {
return
' -D__TYPE__INTEGER____INT16'
;
}
elsif
(
$ivtype
eq
'__int32'
) {
return
' -D__TYPE__INTEGER____INT32'
;
}
elsif
(
$ivtype
eq
'__int64'
) {
return
' -D__TYPE__INTEGER____INT64'
;
}
elsif
(
$ivtype
eq
'__int128'
) {
return
' -D__TYPE__INTEGER____INT128'
;
}
elsif
(
$ivtype
eq
'int8_t'
) {
return
' -D__TYPE__INTEGER__INT8_T'
;
}
elsif
(
$ivtype
eq
'int16_t'
) {
return
' -D__TYPE__INTEGER__INT16_T'
;
}
elsif
(
$ivtype
eq
'int32_t'
) {
return
' -D__TYPE__INTEGER__INT32_T'
;
}
elsif
(
$ivtype
eq
'int64_t'
) {
return
' -D__TYPE__INTEGER__INT64_T'
;
}
elsif
(
$ivtype
eq
'int128_t'
) {
return
' -D__TYPE__INTEGER__INT128_T'
;
}
}
sub
type_integer_errorcheck {
if
((not
exists
$Config
{ivsize}) or (not
defined
$Config
{ivsize})) {
croak
'ERROR ERPTYREI00: Non-existent or undefined Perl config value $Config{ivsize}, croaking'
;
}
my
string
$ivsize
=
$Config
{ivsize};
if
((not
exists
$Config
{ivtype}) or (not
defined
$Config
{ivtype})) {
croak
'ERROR ERPTYREI01: Non-existent or undefined Perl config value $Config{ivtype}, croaking'
;
}
my
string
$ivtype
=
$Config
{ivtype};
if
(
exists
$ALTERNATE_TYPES_TO_PERLISH_TYPES
->{
$ivtype
}) {
$ivtype
=
$ALTERNATE_TYPES_TO_PERLISH_TYPES
->{
$ivtype
};
}
my
string
$ivtypesize_key
=
$ivtype
.
'size'
;
if
((not
exists
$Config
{
$ivtypesize_key
}) or (not
defined
$Config
{
$ivtypesize_key
})) {
croak
'ERROR ERPTYREI02: Non-existent or undefined Perl config value $Config{'
.
$ivtypesize_key
.
'}, croaking'
;
}
my
string
$ivtypesize
=
$Config
{
$ivtypesize_key
};
if
(
$ivsize
ne
$ivtypesize
) {
croak
'ERROR ERPTYREI03: Mis-matching Perl config values, $Config{ivsize} = '
.
$ivsize
.
', $Config{'
.
$ivtypesize_key
.
'} = '
.
$ivtypesize
.
', croaking'
;
}
}
sub
type_integer_bitsize_dump {
foreach
my
$o
(
qw(ivsize ivtype use64bitint use64bitall intsize longsize longlongsize d_longlong i8size i8type i16size i16type i32size i32type i64size i64type)
) {
print
q($Config{)
.
$o
.
q(} = )
.
$Config
{
$o
} .
"\n"
;
}
}
sub
type_number_bitsize {
type_number_errorcheck();
return
(
$Config
{nvsize} * 8);
}
sub
type_number_native {
type_number_errorcheck();
return
$Config
{nvtype};
}
sub
type_number_native_ccflag {
type_number_errorcheck();
if
(
$Config
{nvtype} eq
'double'
) {
return
' -D__TYPE__NUMBER__DOUBLE'
;
}
elsif
(
$Config
{nvtype} eq
'longdbl'
) {
return
' -D__TYPE__NUMBER__DOUBLE'
;
}
}
sub
type_number_errorcheck {
if
((not
exists
$Config
{nvsize}) or (not
defined
$Config
{nvsize})) {
croak
'ERROR ERPTYREN00: Non-existent or undefined Perl config value $Config{nvsize}, croaking'
;
}
my
string
$nvsize
=
$Config
{nvsize};
if
((not
exists
$Config
{nvtype}) or (not
defined
$Config
{nvtype})) {
croak
'ERROR ERPTYREN01: Non-existent or undefined Perl config value $Config{nvtype}, croaking'
;
}
my
string
$nvtype
=
$Config
{nvtype};
$nvtype
=~ s/\s//gxms;
my
string
$nvtypesize_key
=
$nvtype
.
'size'
;
if
((not
exists
$Config
{
$nvtypesize_key
}) or (not
defined
$Config
{
$nvtypesize_key
})) {
if
(
$nvtype
=~ m/double/gxms) {
$nvtype
=~ s/double/dbl/gxms;
my
string
$nvtypesize_key_long
=
$nvtypesize_key
;
$nvtypesize_key
=
$nvtype
.
'size'
;
if
((not
exists
$Config
{
$nvtypesize_key
}) or (not
defined
$Config
{
$nvtypesize_key
})) {
croak
'ERROR ERPTYREN02: Non-existent or undefined Perl config values $Config{'
.
$nvtypesize_key_long
.
'} and $Config{'
.
$nvtypesize_key
.
'}, croaking'
;
}
}
else
{
croak
'ERROR ERPTYREN03: Non-existent or undefined Perl config value $Config{'
.
$nvtypesize_key
.
'}, croaking'
;
}
}
my
string
$nvtypesize
=
$Config
{
$nvtypesize_key
};
if
(
$nvsize
ne
$nvtypesize
) {
croak
'ERROR ERPTYREN04: Mis-matching Perl config values, $Config{nvsize} = '
.
$nvsize
.
', $Config{'
.
$nvtypesize_key
.
'} = '
.
$nvtypesize
.
', croaking'
;
}
}
sub
type_number_bitsize_dump {
foreach
my
$o
(
qw(nvsize nvtype use64bitall doublesize longdblsize d_longdbl)
) {
print
q($Config{)
.
$o
.
q(} = )
.
$Config
{
$o
} .
"\n"
;
}
}
1;