U/perl/infnan.U

   1 ?RCS: $Id$
   2 ?RCS:
   3 ?RCS: Copyright (c) 2015 Jarkko Hietaniemi, H.Merijn Brand
   4 ?RCS:
   5 ?RCS: You may distribute under the terms of either the GNU General Public
   6 ?RCS: License or the Artistic License, as specified in the README file.
   7 ?RCS:
   8 ?MAKE:longdblinfbytes longdblnanbytes doubleinfbytes doublenanbytes: Inlibc \
   9         cat i_math i_string Compile run rm_try Setvar echo d_longdbl \
  10         doublekind doublesize longdblkind longdblsize
  11 ?MAKE:  -pick add $@ %<
  12 ?S:longdblinfbytes:
  13 ?S:     This variable contains comma-separated list of hexadecimal bytes
  14 ?S:     for the long double precision infinity.
  15 ?S:.
  16 ?S:longdblnanbytes:
  17 ?S:     This variable contains comma-separated list of hexadecimal bytes
  18 ?S:     for the long double precision not-a-number.
  19 ?S:.
  20 ?S:doubleinfbytes:
  21 ?S:     This variable contains comma-separated list of hexadecimal bytes
  22 ?S:     for the double precision infinity.
  23 ?S:.
  24 ?S:doublenanbytes:
  25 ?S:     This variable contains comma-separated list of hexadecimal bytes
  26 ?S:     for the double precision not-a-number.
  27 ?S:.
  28 ?C:DOUBLEINFBYTES:
  29 ?C:     This symbol, if defined, is a comma-separated list of
  30 ?C:     hexadecimal bytes for the double precision infinity.
  31 ?C:.
  32 ?C:DOUBLENANBYTES:
  33 ?C:     This symbol, if defined, is a comma-separated list of
  34 ?C:     hexadecimal bytes (0xHH) for the double precision not-a-number.
  35 ?C:.
  36 ?C:LONGDBLINFBYTES:
  37 ?C:     This symbol, if defined, is a comma-separated list of
  38 ?C:     hexadecimal bytes for the long double precision infinity.
  39 ?C:.
  40 ?C:LONGDBLNANBYTES:
  41 ?C:     This symbol, if defined, is a comma-separated list of
  42 ?C:     hexadecimal bytes (0xHH) for the long double precision not-a-number.
  43 ?C:.
  44 ?H:#define DOUBLEINFBYTES  $doubleinfbytes              /**/
  45 ?H:#define DOUBLENANBYTES  $doublenanbytes              /**/
  46 ?H:#define LONGDBLINFBYTES $longdblinfbytes             /**/
  47 ?H:#define LONGDBLNANBYTES $longdblnanbytes             /**/
  48 ?H:.
  49 ?F:!try
  50 : Check what kind of inf/nan your system has
  51 $echo "Checking the kind of infinities and nans you have..." >&4
  52 $echo "(The following tests may crash.  That's okay.)" >&4
  53 $cat >try.c <<EOP
  54 #define DOUBLESIZE $doublesize
  55 #$d_longdbl HAS_LONG_DOUBLE
  56 #ifdef HAS_LONG_DOUBLE
  57 #define LONG_DOUBLESIZE $longdblsize
  58 #define LONG_DOUBLEKIND $longdblkind
  59 #endif
  60 #$i_math I_MATH
  61 #$i_string I_STRING
  62 #ifdef I_MATH
  63 #include <math.h>
  64 #endif
  65 #ifdef I_STRING
  66 #  include <string.h>
  67 #endif
  68 #include <stdio.h>
  69 /* Note that whether the sign bit is on or off
  70  * for NaN depends on the CPU/FPU, and possibly
  71  * can be affected by the build toolchain.
  72  *
  73  * For example for older MIPS and HP-PA 2.0 the quiet NaN is:
  74  * 0x7f, 0xf7, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff
  75  * 0x7f, 0xf4, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
  76  * (respectively) as opposed to the more usual
  77  * 0x7f, 0xf8, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
  78  *
  79  * Pre-IEEE-754 floating point format do not even have inf/nan support
  80  * at all.  They might have a "max" value (DBL_MAX), which may be deadly
  81  * to even mention, causing immediate SIGFPE or equivalent: this is
  82  * the case with VAX floating point, for example.
  83  */
  84 static void bytes(void *v, unsigned int n) {
  85   unsigned char *p = (unsigned char *)v;
  86   int i;
  87   for (i = 0; i < n; i++) {
  88     printf("0x%02x%s", p[i], i < n - 1 ? ", " : "\n");
  89   }
  90 }
  91 int main(int argc, char *argv[]) {
  92    /* We cannot use 1.0/0.0 and 0.0/0.0 (with L suffixes for long double)
  93     * because some compilers are 'smart' and not only warn but refuse to
  94     * compile such 'illegal' values. */
  95    double dinf = exp(1e9);
  96    double dnan = sqrt(-1.0);
  97 #ifdef HAS_LONG_DOUBLE
  98    long double ldinf = (long double)exp(1e9);
  99    long double ldnan = (long double)sqrt(-1.0);
 100 # if LONG_DOUBLEKIND == 3 || LONG_DOUBLEKIND == 4
 101 /* the 80-bit long doubles might have garbage in their excess bytes */
 102     memset((char *)&ldinf + 10, '\0', LONG_DOUBLESIZE - 10);
 103     memset((char *)&ldnan + 10, '\0', LONG_DOUBLESIZE - 10);
 104 # endif
 105   if (argc == 2) {
 106     switch (argv[1][0]) {
 107     case '1': bytes(&dinf, sizeof(dinf)); break;
 108     case '2': bytes(&dnan, sizeof(dnan)); break;
 109     case '3': bytes(&ldinf, sizeof(ldinf)); break;
 110     case '4': bytes(&ldnan, sizeof(ldnan)); break;
 111 #endif
 112     }
 113   }
 114   return 0;
 115 }
 116 EOP
 117 set try
 118 if eval $compile; then
 119     doubleinfbytes=`$run ./try 1`
 120     doublenanbytes=`$run ./try 2`
 121     case "$d_longdbl" in
 122     $define)
 123       longdblinfbytes=`$run ./try 3`
 124       longdblnanbytes=`$run ./try 4`
 125       ;;
 126     esac
 127 else
 128     # Defaults in case the above test program failed.
 129     case "$doublekind" in
 130     1) # IEEE 754 32-bit LE
 131        doubleinfbytes='0x00, 0x00, 0xf0, 0x7f'
 132        doublenanbytes='0x00, 0x00, 0xf8, 0x7f'
 133        ;;
 134     2) # IEEE 754 32-bit BE
 135        doubleinfbytes='0x7f, 0xf0, 0x00, 0x00'
 136        doublenanbytes='0x7f, 0xf8, 0x00, 0x00'
 137        ;;
 138     3) # IEEE 754 64-bit LE
 139        doubleinfbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x7f'
 140        doublenanbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x7f'
 141        ;;
 142     4) # IEEE 754 64-bit BE
 143        doubleinfbytes='0x7f, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 144        doublenanbytes='0x7f, 0xf8, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 145        ;;
 146     5) # IEEE 754 128-bit LE
 147        doubleinfbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x7f'
 148        doublenanbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x7f'
 149        ;;
 150     6) # IEEE 754 128-bit BE
 151        doubleinfbytes='0x7f, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 152        doublenanbytes='0x7f, 0xf8, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 153        ;;
 154     7) # IEEE 754 64-bit mixed: 32-bit LEs in BE
 155        doubleinfbytes='0x00, 0x00, 0xf0, 0x7f, 0x00, 0x00, 0x00, 0x00'
 156        doublenanbytes='0x00, 0x00, 0xf8, 0x7f, 0x00, 0x00, 0x00, 0x00'
 157        ;;
 158     8) # IEEE 754 64-bit mixed: 32-bit BEs in LE
 159        doubleinfbytes='0x00, 0x00, 0x00, 0x00, 0x7f, 0xf0, 0x00, 0x00'
 160        doublenanbytes='0x00, 0x00, 0x00, 0x00, 0x7f, 0xf8, 0x00, 0x00'
 161        ;;
 162     9|10|11|12|13|14) # VAX/Cray/IBM floating point formats, no inf/nan.
 163        doubleinfbytes=$undef
 164        doublenanbytes=$undef
 165        ;;
 166     *) # No idea.
 167        doubleinfbytes=$undef
 168        doublenanbytes=$undef
 169        ;;
 170     esac
 171     case "$longdblkind" in
 172     1) # IEEE 754 128-bit LE
 173        longdblinfbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x7f'
 174        longdblnanbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0x7f'
 175        ;;
 176     2) # IEEE 754 128-bit BE
 177        longdblinfbytes='0x7f, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 178        longdblnanbytes='0x7f, 0xff, 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 179        ;;
 180     3) # IEEE 754 80-bit LE, 12 or 16 bytes (x86)
 181        case "$longdblsize" in
 182        12) # x86 32-bit (96 bits, or 4 x 32, or 12 x 8)
 183            longdblinfbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0x7f, 0x00, 0x00'
 184            longdblnanbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0x7f, 0x00, 0x00'
 185            ;;
 186        16) # x86_64
 187            longdblinfbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 188            longdblnanbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 189            ;;
 190        *)  # No idea.
 191            longdblinfbytes=$undef
 192            longdblnanbytes=$undef
 193        ;;
 194        esac
 195        ;;
 196     4) # IEEE 754 80-bit BE, 12 or 16 bytes
 197        case "$longdblsize" in
 198        12) # 32-bit system
 199            longdblinfbytes='0x7f, 0xff, 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 200            longdblnanbytes='0x7f, 0xff, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 201            ;;
 202        16) # 64-bit system
 203            longdblinfbytes='0x7f, 0xff, 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 204            longdblnanbytes='0x7f, 0xff, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 205            ;;
 206        *)  # No idea.
 207            longdblinfbytes=$undef
 208            longdblnanbytes=$undef
 209        ;;
 210        esac
 211        ;;
 212     5) # 128-bit LE-LE "double double"
 213        longdblinfbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x7f'
 214        longdblnanbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x7f'
 215        ;;
 216     6) # 128-bit BE-BE "double double"
 217        longdblinfbytes='0x7f, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 218        longdblnanbytes='0x7f, 0xf8, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 219        ;;
 220     7) # 128-bit LE-BE "double double"
 221        longdblinfbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 222        longdblnanbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 223        ;;
 224     8) # 128-bit BE-LE "double double"
 225        longdblinfbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7f, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 226        longdblnanbytes='0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7f, 0xf8, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00'
 227        ;;
 228     9|10|11|12|13|14) # VAX/Cray/IBM floating point formats, no inf/nan.
 229        longdblinfbytes=$undef
 230        longdblnanbytes=$undef
 231        ;;
 232     *) # No idea.
 233        longdblinfbytes=$undef
 234        longdblnanbytes=$undef
 235        ;;
 236     esac
 237 fi
 238 # In case the program crashed the values are empty, turn them undef.
 239 case "$doubleinfbytes" in
 240 '') doubleinfbytes=$undef ;;
 241 esac
 242 case "$doublenanbytes" in
 243 '') doublenanbytes=$undef ;;
 244 esac
 245 case "$longdblinfbytes" in
 246 '') longdblinfbytes=$undef ;;
 247 esac
 248 case "$longdblnanbytes" in
 249 '') longdblnanbytes=$undef ;;
 250 esac
 251 $rm_try
 252