| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Data::IEEE754::Tools; | 
| 2 | 6 |  |  | 6 |  | 77916 | use 5.006; | 
|  | 6 |  |  |  |  | 15 |  | 
| 3 | 6 |  |  | 6 |  | 19 | use warnings; | 
|  | 6 |  |  |  |  | 5 |  | 
|  | 6 |  |  |  |  | 116 |  | 
| 4 | 6 |  |  | 6 |  | 17 | use strict; | 
|  | 6 |  |  |  |  | 12 |  | 
|  | 6 |  |  |  |  | 87 |  | 
| 5 | 6 |  |  | 6 |  | 16 | use Carp; | 
|  | 6 |  |  |  |  | 6 |  | 
|  | 6 |  |  |  |  | 359 |  | 
| 6 | 6 |  |  | 6 |  | 19 | use Exporter 'import';  # just use the import() function, without the rest of the overhead of ISA | 
|  | 6 |  |  |  |  | 6 |  | 
|  | 6 |  |  |  |  | 176 |  | 
| 7 |  |  |  |  |  |  |  | 
| 8 | 6 |  |  | 6 |  | 2142 | use version 0.77; our $VERSION = version->declare('0.011_004'); # underscore makes it "alpha"/"developer" on CPAN, so it will go thru CPAN TESTERS, but not distribute to the world | 
|  | 6 |  |  |  |  | 7992 |  | 
|  | 6 |  |  |  |  | 28 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | =pod | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | =head1 NAME | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | Data::IEEE754::Tools - Various tools for understanding and manipulating the underlying IEEE-754 representation of floating point values | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | use Data::IEEE754::Tools qw/:floatingpoint :ulp/; | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | # return -12.875 as decimal and hexadecimal floating point numbers | 
| 21 |  |  |  |  |  |  | to_dec_floatingpoint(-12.875);          # -0d1.6093750000000000p+0003 | 
| 22 |  |  |  |  |  |  | to_hex_floatingpoint(-12.875);          # -0x1.9c00000000000p+0003 | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | # shows the smallest value you can add or subtract to 16.16 (ulp = "Unit in the Last Place") | 
| 25 |  |  |  |  |  |  | print ulp( 16.16 );                     # 3.5527136788005e-015 | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | # toggles the ulp: returns a float that has the ULP of 16.16 toggled | 
| 28 |  |  |  |  |  |  | #   (if it was a 1, it will be 0, and vice versa); | 
| 29 |  |  |  |  |  |  | #   running it twice should give the original value | 
| 30 |  |  |  |  |  |  | print $t16 = toggle_ulp( 16.16 );   # 16.159999999999997 | 
| 31 |  |  |  |  |  |  | print $v16 = toggle_ulp( $t16 );    # 16.160000000000000 | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 34 |  |  |  |  |  |  |  | 
| 35 |  |  |  |  |  |  | *** ALPHA RELEASE v0.011_004: trying out a bugfix with CPAN Testers (since the bug | 
| 36 |  |  |  |  |  |  | doesn't show up in any of my machines or perl versions, but is all throughout | 
| 37 |  |  |  |  |  |  | CPAN Testers reports *** | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | These tools give access to the underlying IEEE 754 floating-point 64bit representation | 
| 40 |  |  |  |  |  |  | used by many instances of Perl (see L).  They include functions for converting | 
| 41 |  |  |  |  |  |  | from the 64bit internal representation to a string that shows those bits (either as | 
| 42 |  |  |  |  |  |  | hexadecimal or binary) and back, functions for converting that encoded value | 
| 43 |  |  |  |  |  |  | into a more human-readable format to give insight into the meaning of the encoded | 
| 44 |  |  |  |  |  |  | values, and functions to manipulate the smallest possible change for a given | 
| 45 |  |  |  |  |  |  | floating-point value (which is the L or | 
| 46 |  |  |  |  |  |  | "Unit in the Last Place"). | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | =head2 IEEE 754 Encoding | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | The L standard describes | 
| 51 |  |  |  |  |  |  | various floating-point encodings.  The double format (`binary64') is a 64-bit base-2 | 
| 52 |  |  |  |  |  |  | encoding, and correpsonds to the usual Perl floating value (NV). The format  includes the | 
| 53 |  |  |  |  |  |  | sign (s), the power of 2 (q), and a significand (aka, mantissa; the coefficient, c): | 
| 54 |  |  |  |  |  |  | C. The C<(-1)**s> term evaluates to the sign of the | 
| 55 |  |  |  |  |  |  | number, where s=0 means the sign is +1 and s=1 means the sign is -1. | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | For most numbers, the coefficient is an implied 1 plus an encoded fraction, | 
| 58 |  |  |  |  |  |  | which is itself encoded as a 52-bit integer divided by an implied 2**52. The range of | 
| 59 |  |  |  |  |  |  | valid exponents is from -1022 to +1023, which are encoded as an 11bit integer from 1 | 
| 60 |  |  |  |  |  |  | to 2046 (where C).  With an 11bit integer, | 
| 61 |  |  |  |  |  |  | there are two exponent values (C<0b000_0000_0000 = 0 - 1023 = -1023> and | 
| 62 |  |  |  |  |  |  | C<0b111_1111_1111 = 2047 - 1023 = +1024>), which are used to indicate conditions outside | 
| 63 |  |  |  |  |  |  | the normal range: The first special encoded-exponent, C<0b000_0000_0000>, indicates that | 
| 64 |  |  |  |  |  |  | the coefficient is 0 plus the encoded fraction, at an exponent of -1022; thus, the | 
| 65 |  |  |  |  |  |  | floating-point zero is  encoded using an encoded-exponent of 0 and an encoded-fraction of 0 | 
| 66 |  |  |  |  |  |  | (C<[0 + 0/(2**52)] * [2**-1022] = 0*(2**-1022) = 0>); other numbers | 
| 67 |  |  |  |  |  |  | smaller than can normally be encoded (so-called "denormals" or "subnormals"), lying | 
| 68 |  |  |  |  |  |  | between 0 and 1 (non-inclusive) are encoded with the same exponent, but have a non-zero | 
| 69 |  |  |  |  |  |  | encoded-fraction.  The second special encoded-exponent, C<0b111_1111_1111>, indicates a | 
| 70 |  |  |  |  |  |  | number that is infinite (too big to represent), or something that is not a number (NAN); | 
| 71 |  |  |  |  |  |  | infinities are indicated by that special exponent and an encoded-fraction of 0; NAN | 
| 72 |  |  |  |  |  |  | is indicated by that special exponent and a non-zero encoded-fraction. | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | =head2 Justification for the existence of B | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | L, or the equivalent L recipe L>, do a | 
| 77 |  |  |  |  |  |  | good job of converting a perl floating value (NV) into the big-endian bytes | 
| 78 |  |  |  |  |  |  | that encode that value, but they don't help you interpret the value. | 
| 79 |  |  |  |  |  |  |  | 
| 80 |  |  |  |  |  |  | L has a similar suite of tools to B, but | 
| 81 |  |  |  |  |  |  | uses numerical methods rather than accessing the underlying bits.  It L | 
| 82 |  |  |  |  |  |  | shown|http://perlmonks.org/?node_id=1167146> that its interpretation function can take | 
| 83 |  |  |  |  |  |  | an order of magnitude longer than a routine that manipulates the underlying bits | 
| 84 |  |  |  |  |  |  | to gather the information. | 
| 85 |  |  |  |  |  |  |  | 
| 86 |  |  |  |  |  |  | This B module combines the two sets of functions, giving | 
| 87 |  |  |  |  |  |  | access to the raw IEEE 754 encoding, or a stringification of the encoding which | 
| 88 |  |  |  |  |  |  | interprets the encoding as a sign and a coefficient and a power of 2, or access to | 
| 89 |  |  |  |  |  |  | the ULP and ULP-manipulating features, all using direct bit manipulation when | 
| 90 |  |  |  |  |  |  | appropriate. | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | =head2 Compatibility | 
| 93 |  |  |  |  |  |  |  | 
| 94 |  |  |  |  |  |  | B works with 64bit floating-point representations. | 
| 95 |  |  |  |  |  |  |  | 
| 96 |  |  |  |  |  |  | If you have a Perl setup which uses a larger representation (for example, | 
| 97 |  |  |  |  |  |  | C | 
| 98 |  |  |  |  |  |  | this module will be reduced in precision to fit the 64bit representation. | 
| 99 |  |  |  |  |  |  |  | 
| 100 |  |  |  |  |  |  | If you have a Perl setup which uses a smaller representation (for example, | 
| 101 |  |  |  |  |  |  | C | 
| 102 |  |  |  |  |  |  | will likely fail, because the unit tests were not set up for lower precision | 
| 103 |  |  |  |  |  |  | inputs.  However, forcing the installation I still allow coercion | 
| 104 |  |  |  |  |  |  | from the smaller Perl NV into a true IEEE 754 double (64bit) floating-point, | 
| 105 |  |  |  |  |  |  | but there is no guarantee it will work. | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | =head1 EXPORTABLE FUNCTIONS AND VARIABLES | 
| 108 |  |  |  |  |  |  |  | 
| 109 |  |  |  |  |  |  | =cut | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | my  @EXPORT_RAW754 = qw(hexstr754_from_double binstr754_from_double hexstr754_to_double binstr754_to_double); | 
| 112 |  |  |  |  |  |  | my  @EXPORT_FLOATING = qw(to_hex_floatingpoint to_dec_floatingpoint); | 
| 113 |  |  |  |  |  |  | my  @EXPORT_ULP = qw(ulp toggle_ulp nextup nextdown nextafter); | 
| 114 |  |  |  |  |  |  |  | 
| 115 |  |  |  |  |  |  | our @EXPORT_OK = (@EXPORT_FLOATING, @EXPORT_RAW754, @EXPORT_ULP); | 
| 116 |  |  |  |  |  |  | our %EXPORT_TAGS = ( | 
| 117 |  |  |  |  |  |  | floating        => [@EXPORT_FLOATING], | 
| 118 |  |  |  |  |  |  | floatingpoint   => [@EXPORT_FLOATING], | 
| 119 |  |  |  |  |  |  | raw754          => [@EXPORT_RAW754], | 
| 120 |  |  |  |  |  |  | ulp             => [@EXPORT_ULP], | 
| 121 |  |  |  |  |  |  | all             => [@EXPORT_OK], | 
| 122 |  |  |  |  |  |  | ); | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | =head2 :raw754 | 
| 125 |  |  |  |  |  |  |  | 
| 126 |  |  |  |  |  |  | These are the functions to do raw conversion from a floating-point value to a hexadecimal or binary | 
| 127 |  |  |  |  |  |  | string of the underlying IEEE754 encoded value, and back. | 
| 128 |  |  |  |  |  |  |  | 
| 129 |  |  |  |  |  |  | =head3 hexstr754_from_double( I ) | 
| 130 |  |  |  |  |  |  |  | 
| 131 |  |  |  |  |  |  | Converts the floating-point I into a big-endian hexadecimal representation of the underlying | 
| 132 |  |  |  |  |  |  | IEEE754 encoding. | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | hexstr754_from_double(12.875);      #  4029C00000000000 | 
| 135 |  |  |  |  |  |  | #  ^^^ | 
| 136 |  |  |  |  |  |  | #  :  ^^^^^^^^^^^^^ | 
| 137 |  |  |  |  |  |  | #  :  : | 
| 138 |  |  |  |  |  |  | #  :  `- fraction | 
| 139 |  |  |  |  |  |  | #  : | 
| 140 |  |  |  |  |  |  | #  `- sign+exponent | 
| 141 |  |  |  |  |  |  |  | 
| 142 |  |  |  |  |  |  | The first three nibbles (hexadecimal digits) encode the sign and the exponent.  The sign is | 
| 143 |  |  |  |  |  |  | the most significant bit of the three nibbles (so AND the first nibble with 8; if it's true, | 
| 144 |  |  |  |  |  |  | the number is negative, else it's positive).  The remaining 11 bits of the nibbles encode the | 
| 145 |  |  |  |  |  |  | exponent: convert the 11bits to decimal, then subtract 1023.  If the resulting exponent is -1023, | 
| 146 |  |  |  |  |  |  | it indicates a zero or denormal value; if the exponent is +1024, it indicates an infinite (Inf) or | 
| 147 |  |  |  |  |  |  | not-a-number (NaN) value, which are generally used to indicate the calculation has grown to large | 
| 148 |  |  |  |  |  |  | to fit in an IEEE754 double (Inf) or has tried an performed some other undefined operation (divide | 
| 149 |  |  |  |  |  |  | by zero or the logarithm of a zero or negative value) (NaN). | 
| 150 |  |  |  |  |  |  |  | 
| 151 |  |  |  |  |  |  | The final thirteen nibbles are the encoding of the fractional value (usually C<1 + thirteennibbles / | 
| 152 |  |  |  |  |  |  | 16**13>, unless it's zero, denormal, infinite, or not a number). | 
| 153 |  |  |  |  |  |  |  | 
| 154 |  |  |  |  |  |  | Of course, this is easier to decode using the L function, which interprets | 
| 155 |  |  |  |  |  |  | the sign, fraction, and exponent for you.  (See below for more details.) | 
| 156 |  |  |  |  |  |  |  | 
| 157 |  |  |  |  |  |  | to_dec_floatingpoint(12.875);       # +0d1.6093750000000000p+0003 | 
| 158 |  |  |  |  |  |  | # ^  ^^^^^^^^^^^^^^^^^^  ^^^^ | 
| 159 |  |  |  |  |  |  | # :  :                   : | 
| 160 |  |  |  |  |  |  | # :  `- coefficient      `- exponent (power of 2) | 
| 161 |  |  |  |  |  |  | # : | 
| 162 |  |  |  |  |  |  | # `- sign | 
| 163 |  |  |  |  |  |  |  | 
| 164 |  |  |  |  |  |  | =head3 binstr754_from_double( I ) | 
| 165 |  |  |  |  |  |  |  | 
| 166 |  |  |  |  |  |  | Converts the floating-point I into a big-endian binary representation of the underlying | 
| 167 |  |  |  |  |  |  | IEEE754 encoding. | 
| 168 |  |  |  |  |  |  |  | 
| 169 |  |  |  |  |  |  | binstr754_from_double(12.875);      # 0100000000101001110000000000000000000000000000000000000000000000 | 
| 170 |  |  |  |  |  |  | # ^ | 
| 171 |  |  |  |  |  |  | # `- sign | 
| 172 |  |  |  |  |  |  | #  ^^^^^^^^^^^ | 
| 173 |  |  |  |  |  |  | #  `- exponent | 
| 174 |  |  |  |  |  |  | #             ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ | 
| 175 |  |  |  |  |  |  | #             `- fraction | 
| 176 |  |  |  |  |  |  |  | 
| 177 |  |  |  |  |  |  | The first bit is the sign, the next 11 are the exponent's encoding | 
| 178 |  |  |  |  |  |  |  | 
| 179 |  |  |  |  |  |  | =head3 hexstr754_to_double( I ) | 
| 180 |  |  |  |  |  |  |  | 
| 181 |  |  |  |  |  |  | The inverse of I: it takes a string representing the 16 nibbles | 
| 182 |  |  |  |  |  |  | of the IEEE754 double value, and converts it back to a perl floating-point value. | 
| 183 |  |  |  |  |  |  |  | 
| 184 |  |  |  |  |  |  | print hexstr754_to_double('4029C00000000000'); | 
| 185 |  |  |  |  |  |  | 12.875 | 
| 186 |  |  |  |  |  |  |  | 
| 187 |  |  |  |  |  |  | =head3 binstr754_to_double( I ) | 
| 188 |  |  |  |  |  |  |  | 
| 189 |  |  |  |  |  |  | The inverse of I: it takes a string representing the 64 bits | 
| 190 |  |  |  |  |  |  | of the IEEE754 double value, and converts it back to a perl floating-point value. | 
| 191 |  |  |  |  |  |  |  | 
| 192 |  |  |  |  |  |  | print binstr754_to_double('0100000000101001110000000000000000000000000000000000000000000000'); | 
| 193 |  |  |  |  |  |  | 12.875 | 
| 194 |  |  |  |  |  |  |  | 
| 195 |  |  |  |  |  |  | =cut | 
| 196 |  |  |  |  |  |  | # Perl 5.10 introduced the ">" and "<" modifiers for pack which can be used to | 
| 197 |  |  |  |  |  |  | # force a specific endianness. | 
| 198 |  |  |  |  |  |  | if( $] lt '5.010' ) { | 
| 199 |  |  |  |  |  |  | my $str = join('', unpack("H*", pack 'L' => 0x12345678)); | 
| 200 |  |  |  |  |  |  | if('78563412' eq $str) {        # little endian, so reverse byteorder | 
| 201 |  |  |  |  |  |  | *hexstr754_from_double  = sub { return uc unpack('H*' => reverse pack 'd'  => shift); }; | 
| 202 |  |  |  |  |  |  | *binstr754_from_double  = sub { return uc unpack('B*' => reverse pack 'd'  => shift); }; | 
| 203 |  |  |  |  |  |  |  | 
| 204 |  |  |  |  |  |  | *hexstr754_to_double    = sub { return    unpack('d'  => reverse pack 'H*' => shift); }; | 
| 205 |  |  |  |  |  |  | *binstr754_to_double    = sub { return    unpack('d'  => reverse pack 'B*' => shift); }; | 
| 206 |  |  |  |  |  |  |  | 
| 207 |  |  |  |  |  |  | *arr2x32b_from_double   = sub { return    unpack('N2' => reverse pack 'd'  => shift); }; | 
| 208 |  |  |  |  |  |  | } elsif('12345678' eq $str) {   # big endian, so keep default byteorder | 
| 209 |  |  |  |  |  |  | *hexstr754_from_double  = sub { return uc unpack('H*' =>         pack 'd'  => shift); }; | 
| 210 |  |  |  |  |  |  | *binstr754_from_double  = sub { return uc unpack('B*' =>         pack 'd'  => shift); }; | 
| 211 |  |  |  |  |  |  |  | 
| 212 |  |  |  |  |  |  | *hexstr754_to_double    = sub { return    unpack('d'  =>         pack 'H*' => shift); }; | 
| 213 |  |  |  |  |  |  | *binstr754_to_double    = sub { return    unpack('d'  =>         pack 'B*' => shift); }; | 
| 214 |  |  |  |  |  |  |  | 
| 215 |  |  |  |  |  |  | *arr2x32b_from_double   = sub { return    unpack('N2' =>         pack 'd'  => shift); }; | 
| 216 |  |  |  |  |  |  | } else { | 
| 217 |  |  |  |  |  |  | # I don't handle middle-endian / mixed-endian; sorry | 
| 218 |  |  |  |  |  |  | *hexstr754_from_double = sub { undef }; | 
| 219 |  |  |  |  |  |  | *binstr754_from_double = sub { undef }; | 
| 220 |  |  |  |  |  |  |  | 
| 221 |  |  |  |  |  |  | *hexstr754_to_double     = sub { undef }; | 
| 222 |  |  |  |  |  |  | *binstr754_to_double     = sub { undef }; | 
| 223 |  |  |  |  |  |  | } | 
| 224 |  |  |  |  |  |  | } else { | 
| 225 | 153 |  |  | 153 |  | 393 | *hexstr754_from_double  = sub { return uc unpack('H*' =>         pack 'd>' => shift); }; | 
| 226 | 91 |  |  | 91 |  | 5834 | *binstr754_from_double  = sub { return uc unpack('B*' =>         pack 'd>' => shift); }; | 
| 227 |  |  |  |  |  |  |  | 
| 228 | 1261 |  |  | 1261 |  | 151830 | *hexstr754_to_double    = sub { return    unpack('d>' =>         pack 'H*' => shift); }; | 
| 229 | 55 |  |  | 55 |  | 5755 | *binstr754_to_double    = sub { return    unpack('d>' =>         pack 'B*' => shift); }; | 
| 230 |  |  |  |  |  |  |  | 
| 231 | 270 |  |  | 270 |  | 602 | *arr2x32b_from_double   = sub { return    unpack('N2' =>         pack 'd>' => shift); }; | 
| 232 |  |  |  |  |  |  | } | 
| 233 |  |  |  |  |  |  |  | 
| 234 |  |  |  |  |  |  | =head2 :floatingpoint | 
| 235 |  |  |  |  |  |  |  | 
| 236 |  |  |  |  |  |  | =head3 to_hex_floatingpoint( I ) | 
| 237 |  |  |  |  |  |  |  | 
| 238 |  |  |  |  |  |  | =head3 to_dec_floatingpoint( I ) | 
| 239 |  |  |  |  |  |  |  | 
| 240 |  |  |  |  |  |  | Converts value to a hexadecimal or decimal floating-point notation that indicates the sign and | 
| 241 |  |  |  |  |  |  | the coefficient and the power of two, with the coefficient either in hexadecimal or decimal | 
| 242 |  |  |  |  |  |  | notation. | 
| 243 |  |  |  |  |  |  |  | 
| 244 |  |  |  |  |  |  | to_hex_floatingpoint(-3.9999999999999996)    # -0x1.fffffffffffffp+0001 | 
| 245 |  |  |  |  |  |  | to_dec_floatingpoint(-3.9999999999999996)    # -0d1.9999999999999998p+0001 | 
| 246 |  |  |  |  |  |  |  | 
| 247 |  |  |  |  |  |  | It displays the value as (sign)(0base)(implied).(fraction)p(exponent): | 
| 248 |  |  |  |  |  |  |  | 
| 249 |  |  |  |  |  |  | =cut | 
| 250 |  |  |  |  |  |  |  | 
| 251 |  |  |  |  |  |  | sub to_hex_floatingpoint { | 
| 252 |  |  |  |  |  |  | # thanks to BrowserUK @ http://perlmonks.org/?node_id=1167146 for slighly better decision factors | 
| 253 |  |  |  |  |  |  | # I tweaked it to use the two 32bit words instead of one 64bit word (which wouldn't work on some systems) | 
| 254 | 68 |  |  | 68 | 1 | 316 | my $v = shift; | 
| 255 | 68 |  |  |  |  | 88 | my ($msb,$lsb) = arr2x32b_from_double($v); | 
| 256 | 68 |  |  |  |  | 83 | my $sbit = ($msb & 0x80000000) >> 31; | 
| 257 | 68 | 100 |  |  |  | 98 | my $sign = $sbit ? '-' : '+'; | 
| 258 | 68 |  |  |  |  | 62 | my $exp  = (($msb & 0x7FF00000) >> 20) - 1023; | 
| 259 | 68 |  |  |  |  | 197 | my $mant = sprintf '%05x%08x', $msb & 0x000FFFFF, $lsb & 0xFFFFFFFF; | 
| 260 | 68 | 100 |  |  |  | 114 | if($exp == 1024) { | 
| 261 | 12 | 100 |  |  |  | 63 | return $sign . "0x1.#INF000000000p+0000"    if $mant eq '0000000000000'; | 
| 262 | 10 | 100 | 100 |  |  | 40 | return $sign . "0x1.#IND000000000p+0000"    if $mant eq '8000000000000' and $sign eq '-'; | 
| 263 | 9 | 100 |  |  |  | 186 | return $sign . ( (($msb & 0x00080000) != 0x00080000) ? "0x1.#SNAN00000000p+0000" : "0x1.#QNAN00000000p+0000"); | 
| 264 |  |  |  |  |  |  | } | 
| 265 | 56 |  |  |  |  | 51 | my $implied = 1; | 
| 266 | 56 | 100 |  |  |  | 70 | if( $exp == -1023 ) { # zero or denormal | 
| 267 | 6 |  |  |  |  | 5 | $implied = 0; | 
| 268 | 6 | 100 |  |  |  | 10 | $exp = $mant eq '0000000000000' ? 0 : -1022;   # 0 for zero, -1022 for denormal | 
| 269 |  |  |  |  |  |  | } | 
| 270 | 56 |  |  |  |  | 1073 | sprintf '%s0x%1u.%13.13sp%+05d', $sign, $implied, $mant, $exp; | 
| 271 |  |  |  |  |  |  | } | 
| 272 |  |  |  |  |  |  |  | 
| 273 |  |  |  |  |  |  | sub to_dec_floatingpoint { | 
| 274 |  |  |  |  |  |  | # based on to_hex_floatingpoint | 
| 275 | 68 |  |  | 68 | 1 | 62 | my $v = shift; | 
| 276 | 68 |  |  |  |  | 78 | my ($msb,$lsb) = arr2x32b_from_double($v); | 
| 277 | 68 |  |  |  |  | 98 | my $sbit = ($msb & 0x80000000) >> 31; | 
| 278 | 68 | 100 |  |  |  | 95 | my $sign = $sbit ? '-' : '+'; | 
| 279 | 68 |  |  |  |  | 67 | my $exp  = (($msb & 0x7FF00000) >> 20) - 1023; | 
| 280 | 68 |  |  |  |  | 165 | my $mant = sprintf '%05x%08x', $msb & 0x000FFFFF, $lsb & 0xFFFFFFFF; | 
| 281 | 68 | 100 |  |  |  | 112 | if($exp == 1024) { | 
| 282 | 12 | 100 |  |  |  | 60 | return $sign . "0d1.#INF000000000000p+0000"    if $mant eq '0000000000000'; | 
| 283 | 10 | 100 | 100 |  |  | 42 | return $sign . "0d1.#IND000000000000p+0000"    if $mant eq '8000000000000' and $sign eq '-'; | 
| 284 | 9 | 100 |  |  |  | 170 | return $sign . ( (($msb & 0x00080000) != 0x00080000) ? "0d1.#SNAN00000000000p+0000" : "0d1.#QNAN00000000000p+0000"); | 
| 285 |  |  |  |  |  |  | } | 
| 286 | 56 |  |  |  |  | 36 | my $implied = 1; | 
| 287 | 56 | 100 |  |  |  | 71 | if( $exp == -1023 ) { # zero or denormal | 
| 288 | 6 |  |  |  |  | 18 | $implied = 0; | 
| 289 | 6 | 100 |  |  |  | 11 | $exp = $mant eq '0000000000000' ? 0 : -1022;   # 0 for zero, -1022 for denormal | 
| 290 |  |  |  |  |  |  | } | 
| 291 |  |  |  |  |  |  | #$mant = (($msb & 0x000FFFFF)*4_294_967_296.0 + ($lsb & 0xFFFFFFFF)*1.0) / (2.0**52); | 
| 292 |  |  |  |  |  |  | #sprintf '%s0d%1u.%.16fp%+05d', $sign, $implied, $mant, $exp; | 
| 293 | 56 |  |  |  |  | 102 | my $other = abs($v) / (2.0**$exp); | 
| 294 | 56 |  |  |  |  | 1241 | sprintf '%s0d%.16fp%+05d', $sign, $other, $exp; | 
| 295 |  |  |  |  |  |  | } | 
| 296 |  |  |  |  |  |  |  | 
| 297 |  |  |  |  |  |  |  | 
| 298 |  |  |  |  |  |  | =over | 
| 299 |  |  |  |  |  |  |  | 
| 300 |  |  |  |  |  |  | =item sign | 
| 301 |  |  |  |  |  |  |  | 
| 302 |  |  |  |  |  |  | The I will be + or - | 
| 303 |  |  |  |  |  |  |  | 
| 304 |  |  |  |  |  |  | =item 0base | 
| 305 |  |  |  |  |  |  |  | 
| 306 |  |  |  |  |  |  | The I<0base> will be C<0x> for hexadecimal, C<0d> for decimal | 
| 307 |  |  |  |  |  |  |  | 
| 308 |  |  |  |  |  |  | =item implied.fraction | 
| 309 |  |  |  |  |  |  |  | 
| 310 |  |  |  |  |  |  | The I indicates the hexadecimal or decimal equivalent for the coefficient | 
| 311 |  |  |  |  |  |  |  | 
| 312 |  |  |  |  |  |  | I will be 0 for zero or denormal numbers, 1 for everything else | 
| 313 |  |  |  |  |  |  |  | 
| 314 |  |  |  |  |  |  | I will indicate infinities (#INF), signaling not-a-numbers (#SNAN), and quiet not-a-numbers (#QNAN). | 
| 315 |  |  |  |  |  |  |  | 
| 316 |  |  |  |  |  |  | I will range from decimal 0.0000000000000000 to 0.9999999999999998 for zero thru all the denormals, | 
| 317 |  |  |  |  |  |  | and from 1.0000000000000000 to 1.9999999999999998 for normal values. | 
| 318 |  |  |  |  |  |  |  | 
| 319 |  |  |  |  |  |  | =item p | 
| 320 |  |  |  |  |  |  |  | 
| 321 |  |  |  |  |  |  | The I  introduces the "power" of 2.  (It is analogous to the C in C<1.0e3> introducing the power of 10 in a
  | 
| 322 |  |  |  |  |  |  | standard decimal floating-point notation, but indicates that the exponent is 2**exp instead of 10**exp.) | 
| 323 |  |  |  |  |  |  |  | 
| 324 |  |  |  |  |  |  | =item exponent | 
| 325 |  |  |  |  |  |  |  | 
| 326 |  |  |  |  |  |  | The I is the power of 2.  Is is always a decimal number, whether the coefficient's base is hexadecimal or decimal. | 
| 327 |  |  |  |  |  |  |  | 
| 328 |  |  |  |  |  |  | +0d1.500000000000000p+0010 | 
| 329 |  |  |  |  |  |  | = 1.5 * (2**10) | 
| 330 |  |  |  |  |  |  | = 1.5 * 1024.0 | 
| 331 |  |  |  |  |  |  | = 1536.0. | 
| 332 |  |  |  |  |  |  |  | 
| 333 |  |  |  |  |  |  | The I can range from -1022 to +1023. | 
| 334 |  |  |  |  |  |  |  | 
| 335 |  |  |  |  |  |  | Internally, the IEEE 754 representation uses the encoding of -1023 for zero and denormals; to | 
| 336 |  |  |  |  |  |  | aid in understanding the actual number, the I conversions represent | 
| 337 |  |  |  |  |  |  | them as +0000 for zero, and -1022 for denormals: since denormals are C<(0+fraction)*(2**min_exp)>, | 
| 338 |  |  |  |  |  |  | they are really multiples of 2**-1022, not 2**-1023. | 
| 339 |  |  |  |  |  |  |  | 
| 340 |  |  |  |  |  |  | =back | 
| 341 |  |  |  |  |  |  |  | 
| 342 |  |  |  |  |  |  | =head2 :ulp | 
| 343 |  |  |  |  |  |  |  | 
| 344 |  |  |  |  |  |  | =head3 ulp( I ) | 
| 345 |  |  |  |  |  |  |  | 
| 346 |  |  |  |  |  |  | Returns the ULP ("Unit in the Last Place") for the given I, which is the smallest number | 
| 347 |  |  |  |  |  |  | that you can add to or subtract from I and still be able to discern a difference between | 
| 348 |  |  |  |  |  |  | the original and modified.  Under normal (or denormal) circumstances, C $val> | 
| 349 |  |  |  |  |  |  | is true. | 
| 350 |  |  |  |  |  |  |  | 
| 351 |  |  |  |  |  |  | If the I is a zero or a denormal, C will return the smallest possible denormal. | 
| 352 |  |  |  |  |  |  |  | 
| 353 |  |  |  |  |  |  | Since INF and NAN are not really numbers, C will just return the same I.  Because | 
| 354 |  |  |  |  |  |  | of the way they are handled, C $val> no longer makes sense (infinity plus | 
| 355 |  |  |  |  |  |  | anything is still infinity, and adding NAN to NAN is not numerically defined, so a numerical | 
| 356 |  |  |  |  |  |  | comparison is meaningless on both). | 
| 357 |  |  |  |  |  |  |  | 
| 358 |  |  |  |  |  |  | =cut | 
| 359 |  |  |  |  |  |  |  | 
| 360 |  |  |  |  |  |  | sub ulp($) { | 
| 361 | 30 |  |  | 30 | 1 | 61 | my $val = shift; | 
| 362 | 30 |  |  |  |  | 33 | my $rawbin = binstr754_from_double($val); | 
| 363 | 30 |  |  |  |  | 93 | my ($sign, $exp, $fract) = ($rawbin =~ /(.)(.{11})(.{52})/); | 
| 364 |  |  |  |  |  |  |  | 
| 365 |  |  |  |  |  |  | # check for special conditions | 
| 366 | 30 | 100 |  |  |  | 78 | if( $exp == '1'x11 ) {                          # return self for INF or NAN | 
|  |  | 100 |  |  |  |  |  | 
| 367 | 12 |  |  |  |  | 23 | return $val; | 
| 368 |  |  |  |  |  |  | } elsif ( $exp == '0'x11 ) {                    # ZERO or DENORMAL: build (+)(exp:0)(fract:0...1) | 
| 369 | 6 |  |  |  |  | 5 | $fract = '0'x51 . '1'; | 
| 370 | 6 |  |  |  |  | 8 | $rawbin = join '', '0', $exp, $fract; | 
| 371 | 6 |  |  |  |  | 8 | return binstr754_to_double($rawbin); | 
| 372 |  |  |  |  |  |  | } | 
| 373 |  |  |  |  |  |  |  | 
| 374 |  |  |  |  |  |  | # calculate normal ULP | 
| 375 | 12 |  |  |  |  | 14 | my $tog = toggle_ulp( $val ); | 
| 376 | 12 |  |  |  |  | 19 | return abs($val - $tog); | 
| 377 |  |  |  |  |  |  | } | 
| 378 |  |  |  |  |  |  |  | 
| 379 |  |  |  |  |  |  | =head3 toggle_ulp( I ) | 
| 380 |  |  |  |  |  |  |  | 
| 381 |  |  |  |  |  |  | Returns the orginal I, but with the ULP toggled.  In other words, if the ULP bit | 
| 382 |  |  |  |  |  |  | was a 0, it will return a value with the ULP of 1 (equivalent to adding one ULP to a positive | 
| 383 |  |  |  |  |  |  | I); if the ULP bit was a 1, it will return a value with the ULP of 0 (equivalent to | 
| 384 |  |  |  |  |  |  | subtracting one ULP from a positive I).  Under normal (or denormal) circumstances, | 
| 385 |  |  |  |  |  |  | C is true. | 
| 386 |  |  |  |  |  |  |  | 
| 387 |  |  |  |  |  |  | Since INF and NAN are not really numbers, C will just return the same I.  Because | 
| 388 |  |  |  |  |  |  | of the way they are handled, C no longer makes sense. | 
| 389 |  |  |  |  |  |  |  | 
| 390 |  |  |  |  |  |  | =cut | 
| 391 |  |  |  |  |  |  |  | 
| 392 |  |  |  |  |  |  | sub toggle_ulp { | 
| 393 | 38 |  |  | 38 | 1 | 66 | my $val = shift; | 
| 394 | 38 |  |  |  |  | 41 | my $rawbin = binstr754_from_double($val); | 
| 395 | 38 |  |  |  |  | 107 | my ($sign, $exp, $fract) = ($rawbin =~ /(.)(.{11})(.{52})/); | 
| 396 |  |  |  |  |  |  |  | 
| 397 |  |  |  |  |  |  | # INF and NAN do not have a meaningful ULP; just return SELF | 
| 398 | 38 | 100 |  |  |  | 87 | if( $exp == '1'x11 ) { | 
| 399 | 12 |  |  |  |  | 19 | return $val; | 
| 400 |  |  |  |  |  |  | } | 
| 401 |  |  |  |  |  |  |  | 
| 402 |  |  |  |  |  |  | # ZERO, DENORMAL, and NORMAL: toggle the last bit of fract | 
| 403 | 26 |  |  |  |  | 28 | my $ulp_bit = substr $fract, -1; | 
| 404 | 26 |  |  |  |  | 37 | substr $fract, -1, 1, (1-$ulp_bit); | 
| 405 | 26 |  |  |  |  | 31 | $rawbin = join '', $sign, $exp, $fract; | 
| 406 | 26 |  |  |  |  | 31 | return binstr754_to_double($rawbin); | 
| 407 |  |  |  |  |  |  | } | 
| 408 |  |  |  |  |  |  |  | 
| 409 |  |  |  |  |  |  | =head3 nextup( I ) | 
| 410 |  |  |  |  |  |  |  | 
| 411 |  |  |  |  |  |  | Returns the next floating point value numerically greater than I; that is, it adds one ULP. | 
| 412 |  |  |  |  |  |  | Returns infinite when I is the highest normal floating-point value. | 
| 413 |  |  |  |  |  |  | Returns I when I is positive-infinite or NAN; returns the largest negative normal | 
| 414 |  |  |  |  |  |  | floating-point value when I is negative-infinite. | 
| 415 |  |  |  |  |  |  |  | 
| 416 |  |  |  |  |  |  | C is an IEEE 754r standard function. | 
| 417 |  |  |  |  |  |  |  | 
| 418 |  |  |  |  |  |  | =cut | 
| 419 |  |  |  |  |  |  |  | 
| 420 |  |  |  |  |  |  | sub nextup { | 
| 421 |  |  |  |  |  |  | # thanks again to BrowserUK: http://perlmonks.org/?node_id=1167146 | 
| 422 | 172 |  |  | 172 | 1 | 177 | my $val = shift; | 
| 423 | 172 | 100 |  |  |  | 330 | return $val                                     if $val != $val;                # interestingly, NAN != NAN | 
| 424 | 152 |  |  |  |  | 191 | my $h754 = hexstr754_from_double($val); | 
| 425 | 152 | 100 |  |  |  | 259 | return $val                                     if $h754 eq '7FF0000000000000'; # return self               for +INF | 
| 426 | 150 | 100 |  |  |  | 191 | return hexstr754_to_double('FFEFFFFFFFFFFFFF')  if $h754 eq 'FFF0000000000000'; # return largest negative   for -INF | 
| 427 | 138 | 100 |  |  |  | 168 | return hexstr754_to_double('0000000000000001')  if $h754 eq '8000000000000000'; # return +SmallestDenormal  for -ZERO | 
| 428 | 134 |  |  |  |  | 144 | my ($msb,$lsb) = arr2x32b_from_double($val); | 
| 429 | 134 | 100 |  |  |  | 220 | $lsb += ($msb & 0x80000000) ? -1.0 : +1.0; | 
| 430 | 134 | 100 |  |  |  | 227 | if($lsb == 4_294_967_296.0) { | 
|  |  | 100 |  |  |  |  |  | 
| 431 | 22 |  |  |  |  | 21 | $lsb = 0.0; | 
| 432 | 22 | 50 |  |  |  | 31 | $msb += ($msb & 0x80000000) ? -1.0 : +1.0; | 
| 433 |  |  |  |  |  |  | } elsif ($lsb == -1.0) { | 
| 434 | 30 | 50 |  |  |  | 44 | $msb += ($msb & 0x80000000) ? -1.0 : +1.0; | 
| 435 |  |  |  |  |  |  | } | 
| 436 | 134 |  |  |  |  | 90 | $msb &= 0xFFFFFFFF;     # v0.011_001: potential bugfix: ensure 32bit MSB | 
| 437 | 134 |  |  |  |  | 85 | $lsb &= 0xFFFFFFFF;     # v0.011_001: potential bugfix: ensure 32bit MSB | 
| 438 | 134 |  |  |  |  | 401 | return hexstr754_to_double( sprintf '%08X%08X', $msb, $lsb ); | 
| 439 |  |  |  |  |  |  | } | 
| 440 |  |  |  |  |  |  |  | 
| 441 |  |  |  |  |  |  | =head3 nextdown( I ) | 
| 442 |  |  |  |  |  |  |  | 
| 443 |  |  |  |  |  |  | Returns the next floating point value numerically lower than I; that is, it subtracts one ULP. | 
| 444 |  |  |  |  |  |  | Returns -infinity when I is the largest negative normal floating-point value. | 
| 445 |  |  |  |  |  |  | Returns I when I is negative-infinite or NAN; returns the largest positive normal | 
| 446 |  |  |  |  |  |  | floating-point value when I is positive-infinite. | 
| 447 |  |  |  |  |  |  |  | 
| 448 |  |  |  |  |  |  | C is an IEEE 754r standard function. | 
| 449 |  |  |  |  |  |  |  | 
| 450 |  |  |  |  |  |  | =cut | 
| 451 |  |  |  |  |  |  |  | 
| 452 |  |  |  |  |  |  | sub nextdown { | 
| 453 | 86 |  |  | 86 | 1 | 176 | return - nextup( - $_[0] ); | 
| 454 |  |  |  |  |  |  | } | 
| 455 |  |  |  |  |  |  |  | 
| 456 |  |  |  |  |  |  | =head3 nextafter( I, I ) | 
| 457 |  |  |  |  |  |  |  | 
| 458 |  |  |  |  |  |  | Returns the next floating point value after I in the direction of I.  If the | 
| 459 |  |  |  |  |  |  | two are identical, return I; if I is numerically above I, return | 
| 460 |  |  |  |  |  |  | C)>; if I is numerically below I, return C)>. | 
| 461 |  |  |  |  |  |  |  | 
| 462 |  |  |  |  |  |  | C is an IEEE 754r standard function. | 
| 463 |  |  |  |  |  |  |  | 
| 464 |  |  |  |  |  |  | =cut | 
| 465 |  |  |  |  |  |  |  | 
| 466 |  |  |  |  |  |  | sub nextafter { | 
| 467 | 270 | 100 |  | 270 | 1 | 994 | return $_[0]            if $_[0] != $_[0];      # return value when value is NaN | 
| 468 | 160 | 100 |  |  |  | 254 | return $_[1]            if $_[1] != $_[1];      # return direction when direction is NaN | 
| 469 | 140 | 100 |  |  |  | 218 | return $_[1]            if $_[1] == $_[0];      # return direction when the two are equal | 
| 470 | 112 | 100 |  |  |  | 211 | return nextup($_[0])    if $_[1] > $_[0];       # return nextup if direction > value | 
| 471 | 56 |  |  |  |  | 74 | return nextdown($_[0]);                         # otherwise, return nextdown() | 
| 472 |  |  |  |  |  |  | } | 
| 473 |  |  |  |  |  |  |  | 
| 474 |  |  |  |  |  |  | =head2 :all | 
| 475 |  |  |  |  |  |  |  | 
| 476 |  |  |  |  |  |  | Include all of the above. | 
| 477 |  |  |  |  |  |  |  | 
| 478 |  |  |  |  |  |  | =head1 INSTALLATION | 
| 479 |  |  |  |  |  |  |  | 
| 480 |  |  |  |  |  |  | To install this module, use your favorite CPAN client. | 
| 481 |  |  |  |  |  |  |  | 
| 482 |  |  |  |  |  |  | For a manual install, type the following: | 
| 483 |  |  |  |  |  |  |  | 
| 484 |  |  |  |  |  |  | perl Makefile.PL | 
| 485 |  |  |  |  |  |  | make | 
| 486 |  |  |  |  |  |  | make test | 
| 487 |  |  |  |  |  |  | make install | 
| 488 |  |  |  |  |  |  |  | 
| 489 |  |  |  |  |  |  | (On Windows machines, you may need to use "dmake" instead of "make".) | 
| 490 |  |  |  |  |  |  |  | 
| 491 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 492 |  |  |  |  |  |  |  | 
| 493 |  |  |  |  |  |  | =over | 
| 494 |  |  |  |  |  |  |  | 
| 495 |  |  |  |  |  |  | =item * L | 
| 496 |  |  |  |  |  |  |  | 
| 497 |  |  |  |  |  |  | =item * L for | 
| 498 |  |  |  |  |  |  | inspiring me to go down the IEEE754-expansion trail in perl. | 
| 499 |  |  |  |  |  |  |  | 
| 500 |  |  |  |  |  |  | =item * L as a resource | 
| 501 |  |  |  |  |  |  | for how perl interacts with the various "edge cases" (+/-infinity, L, | 
| 502 |  |  |  |  |  |  | signaling and quiet L. | 
| 503 |  |  |  |  |  |  |  | 
| 504 |  |  |  |  |  |  | =item * L: I really wanted to use this module, but it didn't get me very far down the "Tools" track, | 
| 505 |  |  |  |  |  |  | and included a lot of overhead modules for its install/test that I didn't want to require for B. | 
| 506 |  |  |  |  |  |  | However, I was inspired by his byteorder-dependent anonymous subs (which were in turn derived from L); | 
| 507 |  |  |  |  |  |  | they were more efficient, on a per-call-to-subroutine basis, than my original inclusion of the if(byteorder) in every call to | 
| 508 |  |  |  |  |  |  | the sub. | 
| 509 |  |  |  |  |  |  |  | 
| 510 |  |  |  |  |  |  | =item * L: Similar to this module, but uses numeric manipulation. | 
| 511 |  |  |  |  |  |  |  | 
| 512 |  |  |  |  |  |  | =back | 
| 513 |  |  |  |  |  |  |  | 
| 514 |  |  |  |  |  |  | =head1 AUTHOR | 
| 515 |  |  |  |  |  |  |  | 
| 516 |  |  |  |  |  |  | Peter C. Jones Cpetercj AT cpan DOT orgE> | 
| 517 |  |  |  |  |  |  |  | 
| 518 |  |  |  |  |  |  | Please report any bugs or feature requests emailing Cbug-Data-IEEE754-Tools AT rt.cpan.orgE> | 
| 519 |  |  |  |  |  |  | or thru the web interface at L. | 
| 520 |  |  |  |  |  |  |  | 
| 521 |  |  |  |  |  |  | =head1 COPYRIGHT | 
| 522 |  |  |  |  |  |  |  | 
| 523 |  |  |  |  |  |  | Copyright (C) 2016 Peter C. Jones | 
| 524 |  |  |  |  |  |  |  | 
| 525 |  |  |  |  |  |  | =head1 LICENSE | 
| 526 |  |  |  |  |  |  |  | 
| 527 |  |  |  |  |  |  | This program is free software; you can redistribute it and/or modify it | 
| 528 |  |  |  |  |  |  | under the terms of either: the GNU General Public License as published | 
| 529 |  |  |  |  |  |  | by the Free Software Foundation; or the Artistic License. | 
| 530 |  |  |  |  |  |  |  | 
| 531 |  |  |  |  |  |  | See L for more information. | 
| 532 |  |  |  |  |  |  |  | 
| 533 |  |  |  |  |  |  | =cut | 
| 534 |  |  |  |  |  |  |  | 
| 535 |  |  |  |  |  |  | 1; |