Subversion Repositories pentevo

Rev

Blame | Last modification | View Log | Download | RSS feed

  1. /* decfloat.c */
  2. /*****************************************************************************/
  3. /* SPDX-License-Identifier: GPL-2.0-only OR GPL-3.0-only                     */
  4. /*                                                                           */
  5. /* AS                                                                        */
  6. /*                                                                           */
  7. /* DEC<->IEEE Floating Point Conversion on host                              */
  8. /*                                                                           */
  9. /*****************************************************************************/
  10.  
  11. #include "stdinc.h"
  12. #include <math.h>
  13. #include <errno.h>
  14. #include <string.h>
  15.  
  16. #include "be_le.h"
  17. #include "as_float.h"
  18. #include "ieeefloat.h"
  19. #include "decfloat.h"
  20.  
  21. #define DBG_FLOAT 0
  22.  
  23. #ifdef HOST_DECFLOAT
  24.  
  25. #ifdef __GFLOAT
  26. /* Some VAX compilers internally seem to use D float
  27.    and are unable to parse the G float DBL_MAX literal
  28.    of 8.98...E+308 from float.h.
  29.    So we put a hand-crafted constant in memory.
  30.    Note this is only about half of the maximum, but
  31.    putting 0x7ff into the exponent results in a
  32.    floating point exception.  Maybe SIMH misinterpretes
  33.    this as infinity, which does not exist for VAX
  34.    floatingpoint formats? */
  35.  
  36. double as_decfloat_get_max_gfloat(void)
  37. {
  38.   static double max_gfloat;
  39.   static Boolean set = False;
  40.  
  41.   if (!set)
  42.   {
  43.     Byte raw[8] = { 0xef, 0x7f, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff };
  44.     memcpy(&max_gfloat, raw, 8);
  45.     set = True;
  46.   }
  47.   return max_gfloat;
  48. }
  49. #endif /* __GFLOAT */
  50.  
  51. /*!------------------------------------------------------------------------
  52.  * \fn     as_float_dissect(as_float_dissect_t *p_dest, as_float_t num)
  53.  * \brief  dissect (64 bit) float into components - may be D or G float
  54.  * \param  p_dest result buffer
  55.  * \param  num number to dissect
  56.  * ------------------------------------------------------------------------ */
  57.  
  58. void as_float_dissect(as_float_dissect_t *p_dest, as_float_t num)
  59. {
  60.   const Byte *p_src = (const Byte*)&num;
  61.   LongWord mant_h, mant_l;
  62.   Integer biased_exponent;
  63.  
  64.   as_float_zero(p_dest);
  65. #if DBG_FLOAT
  66.   {
  67.     int z;
  68.     printf("%g:", num);
  69.     for (z = 0; z < 8; z++)
  70.       printf(" %02x", p_src[z]);
  71.     printf("\n");
  72.   }
  73. #endif
  74.  
  75.   /* (a) Sign is MSB of highest byte: */
  76.  
  77.   p_dest->negative = !!(p_src[1] & 0x80);
  78.  
  79.   /* (b) Exponent is stored in the following 8/11 bits, with a bias of 128/1024: */
  80.  
  81.   biased_exponent = p_src[1] & 0x7f;
  82. #ifdef __GFLOAT
  83.   biased_exponent = (biased_exponent << 4) | ((p_src[0] >> 4) & 15);
  84. #else
  85.   biased_exponent = (biased_exponent << 1) | ((p_src[0] >> 7) & 1);
  86. #endif
  87.  
  88.   /* (c) remove bias, correct mantissa normalization */
  89.  
  90. #ifdef __GFLOAT
  91.   p_dest->exponent = biased_exponent - 1024;
  92. #else
  93.   p_dest->exponent = biased_exponent - 128;
  94. #endif
  95.   p_dest->exponent--;
  96.  
  97.   /* (d) mantissa parts: */
  98.  
  99.   mant_h = p_src[0]
  100. #ifdef __GFLOAT
  101.          & 0x0f;
  102. #else
  103.          & 0x7f;
  104. #endif
  105.   mant_h = (mant_h << 8) | p_src[3];
  106.   mant_h = (mant_h << 8) | p_src[2];
  107.   mant_l = p_src[5];
  108.   mant_l = (mant_l << 8) | p_src[4];
  109.   mant_l = (mant_l << 8) | p_src[7];
  110.   mant_l = (mant_l << 8) | p_src[6];
  111.  
  112.   /* (e) append leading one (if not zero) and mantissa words: */
  113.  
  114.   as_float_append_mantissa_bits(p_dest, mant_h || mant_l || biased_exponent, 1);
  115. #ifdef __GFLOAT
  116.   as_float_append_mantissa_bits(p_dest, mant_h, 20);
  117. #else
  118.   as_float_append_mantissa_bits(p_dest, mant_h, 23);
  119. #endif
  120.   as_float_append_mantissa_bits(p_dest, mant_l, 32);
  121.  
  122. #if DBG_FLOAT
  123.   as_float_dump(stdout, "(0)", p_dest);
  124. #endif
  125. }
  126.  
  127. /*!------------------------------------------------------------------------
  128.  * \fn     DECF_2_Single(Byte *pDest, float inp)
  129.  * \brief  convert single precision (DEC F) to IEEE single precision
  130.  * \param  pDest where to write
  131.  * \param  inp value to convert
  132.  * ------------------------------------------------------------------------ */
  133.  
  134. void DECF_2_Single(Byte *pDest, float inp)
  135. {
  136.   float tmp = inp;
  137.  
  138.   /* IEEE + DEC layout is the same for single, just the exponent offset is different
  139.      by two: */
  140.  
  141.   tmp /= 4;
  142.   memcpy(pDest, &tmp, 4);
  143.   WSwap(pDest, 4);
  144. }
  145.  
  146. /*!------------------------------------------------------------------------
  147.  * \fn     DECD_2_Double(Byte *pDest, float inp)
  148.  * \brief  convert double precision (DEC D) to IEEE double precision
  149.  * \param  pDest where to write
  150.  * \param  inp value to convert
  151.  * ------------------------------------------------------------------------ */
  152.  
  153. void DECD_2_Double(Byte *pDest, as_float_t inp)
  154. {
  155.   Byte tmp[8];
  156.   Word Exp;
  157.   int z;
  158.   Boolean cont;
  159.  
  160.   memcpy(tmp, &inp, 8);
  161.   WSwap(tmp, 8);
  162.   Exp = ((tmp[0] << 1) & 0xfe) + (tmp[1] >> 7);
  163.   Exp += 894; /* =1023-129 */
  164.   tmp[1] &= 0x7f;
  165.   if ((tmp[7] & 7) > 4)
  166.   {
  167.     for (tmp[7] += 8, cont = tmp[7] < 8, z = 0; cont && z > 1; z--)
  168.     {
  169.       tmp[z]++;
  170.       cont = (tmp[z] == 0);
  171.     }
  172.     if (cont)
  173.     {
  174.       tmp[1]++;
  175.       if (tmp[1] > 127)
  176.         Exp++;
  177.     }
  178.   }
  179.   pDest[7] = (tmp[0] & 0x80) + ((Exp >> 4) & 0x7f);
  180.   pDest[6] = ((Exp & 0x0f) << 4) + ((tmp[1] >> 3) & 0x0f);
  181.   for (z = 5; z >= 0; z--)
  182.     pDest[z] = ((tmp[6 - z] & 7) << 5) | ((tmp[7 - z] >> 3) & 0x1f);
  183. }
  184.  
  185. /*!------------------------------------------------------------------------
  186.  * \fn     DECD_2_LongDouble(Byte *pDest, float inp)
  187.  * \brief  convert double precision (DEC D) to non-IEEE extended precision
  188.  * \param  pDest where to write
  189.  * \param  inp value to convert
  190.  * ------------------------------------------------------------------------ */
  191.  
  192. void DECD_2_LongDouble(Byte *pDest, as_float_t inp)
  193. {
  194.   Byte Buffer[8], Sign;
  195.   Word Exponent;
  196.   int z;
  197.  
  198.   memcpy(Buffer, &inp, 8);
  199.   WSwap(Buffer, 8);
  200.   Sign = (*Buffer) & 0x80;
  201.   Exponent = ((*Buffer) << 1) + ((Buffer[1] & 0x80) >> 7);
  202.   Exponent += (16383 - 129);
  203.   Buffer[1] |= 0x80;
  204.   for (z = 1; z < 8; z++)
  205.     pDest[z] = Buffer[8 - z];
  206.   pDest[0] = 0;
  207.   pDest[9] = Sign | ((Exponent >> 8) & 0x7f);
  208.   pDest[8] = Exponent & 0xff;
  209. }
  210.  
  211. #endif /* DECFLOAT */
  212.  
  213. /*!------------------------------------------------------------------------
  214.  * \fn     as_float_2_dec_lit(as_float_t inp, Byte *p_dest)
  215.  * \brief  convert from host to DEC (VAX) 6 bit float (literal) format
  216.  * \param  inp value to convert
  217.  * \param  p_dest result buffer
  218.  * \return >0 for number of bytes used (1) or <0 for error code
  219.  * ------------------------------------------------------------------------ */
  220.  
  221. extern int as_float_2_dec_lit(as_float_t inp, Byte *p_dest)
  222. {
  223.   int exp;
  224.   double fract_part, nonfract_part;
  225.   int int_part;
  226.  
  227.   for (exp = 7; exp >= 0; exp--, inp *= 2.0)
  228.   {
  229.     if (inp > 120.0)
  230.       return -E2BIG;
  231.     if (inp < 64.0)
  232.       continue;
  233.     fract_part = modf(inp, &nonfract_part);
  234.     if (fract_part != 0.0)
  235.       return -EBADF;
  236.     int_part = (int)nonfract_part;
  237.     if ((int_part & 7) || (int_part < 64))
  238.       return -EBADF;
  239.     *p_dest = (exp << 3) | ((int_part & 0x38) >> 3);
  240.     return 1;
  241.   }
  242.   return -EIO;
  243. }
  244.  
  245. /*!------------------------------------------------------------------------
  246.  * \fn     as_float_2_dec_f(as_float_t inp, Word *p_dest)
  247.  * \brief  convert from host to DEC (PDP/VAX) 4 byte float (F) format
  248.  * \param  inp value to dispose
  249.  * \param  p_dest where to dispose
  250.  * \return >0 for number of words used (2) or <0 for error code
  251.  * ------------------------------------------------------------------------ */
  252.  
  253. int as_float_2_dec_f(as_float_t inp, Word *p_dest)
  254. {
  255. #ifdef HOST_DECFLOAT
  256.   float tmp;
  257.  
  258.   /* native format: */
  259.   if (fabs(inp) > 1.7E38)
  260.     return -E2BIG;
  261.   tmp = inp;
  262.   memcpy(p_dest, &tmp, 4);
  263.  
  264. #else /* !HOST_DECFLOAT */
  265.  
  266.   as_float_dissect_t dissect;
  267.  
  268.   /* Dissect */
  269.  
  270.   as_float_dissect(&dissect, inp);
  271.  
  272.   /* Inf/NaN cannot be represented in target format: */
  273.  
  274.   if ((dissect.fp_class != AS_FP_NORMAL)
  275.    && (dissect.fp_class != AS_FP_SUBNORMAL))
  276.     return -EINVAL;
  277.  
  278.   as_float_round(&dissect, 24);
  279.  
  280.   /* For DEC float, Mantissa is in range 0.5...1.0, instead of 1.0...2.0: */
  281.  
  282.   dissect.exponent++;
  283.   if (dissect.exponent > 127)
  284.     return -E2BIG;
  285.  
  286.   /* DEC float does not handle denormal numbers and truncates to zero: */
  287.  
  288.   if (dissect.fp_class == AS_FP_SUBNORMAL)
  289.   {
  290.     dissect.exponent = -128;
  291.     memset(dissect.mantissa, 0, sizeof dissect.mantissa);
  292.   }
  293.  
  294.   /* add bias to exponent */
  295.  
  296.   dissect.exponent += 128;
  297.  
  298.   /* assemble 1st word (seeeeeeeemmmmmmm): */
  299.  
  300.                                          /* discard highest mantissa bit 23 (implicit leading one) */
  301.   p_dest[0] = (((Word)dissect.negative & 1) << 15)
  302.             | ((dissect.exponent << 7) & 0x7f80u)
  303.             | as_float_mantissa_extract(&dissect, 1, 7);  /* mant bits 22...16 */
  304.   p_dest[1] = as_float_mantissa_extract(&dissect, 8, 16); /* mant bits 15... 0 */
  305.  
  306. #endif /* HOST_DECFLOAT */
  307.  
  308.   return 2;
  309. }
  310.  
  311. /*!------------------------------------------------------------------------
  312.  * \fn     as_float_2_dec_d(as_float_t inp, Word *p_dest)
  313.  * \brief  convert from host to DEC (PDP/VAX) 8 byte float (D) format
  314.  * \param  inp value to dispose
  315.  * \param  p_dest where to dispose
  316.  * \return >0 for number of words used (4) or <0 for error code
  317.  * ------------------------------------------------------------------------ */
  318.  
  319. int as_float_2_dec_d(as_float_t inp, Word *p_dest)
  320. {
  321. #if (defined HOST_DECFLOAT) && (!defined __GFLOAT)
  322.   double tmp;
  323.  
  324.   /* native format: */
  325.   tmp = inp;
  326.   memcpy(p_dest, &tmp, 8);
  327.  
  328. #else /* !HOST_DECFLOAT || __GFLOAT*/
  329.  
  330.   as_float_dissect_t dissect;
  331.  
  332.   /* Dissect */
  333.  
  334.   as_float_dissect(&dissect, inp);
  335.  
  336.   /* Inf/NaN cannot be represented in target format: */
  337.  
  338.   if ((dissect.fp_class != AS_FP_NORMAL)
  339.    && (dissect.fp_class != AS_FP_SUBNORMAL))
  340.     return -EINVAL;
  341.  
  342.   as_float_round(&dissect, 56);
  343.  
  344.   /* For DEC float, Mantissa is in range 0.5...1.0, instead of 1.0...2.0: */
  345.  
  346.   dissect.exponent++;
  347.   if (dissect.exponent > 127)
  348.     return -E2BIG;
  349.  
  350.   /* DEC float does not handle denormal numbers and truncates to zero: */
  351.  
  352.   if (dissect.fp_class == AS_FP_SUBNORMAL)
  353.   {
  354.     dissect.exponent = -128;
  355.     memset(dissect.mantissa, 0, sizeof dissect.mantissa);
  356.   }
  357.  
  358.   /* add bias to exponent */
  359.  
  360.   dissect.exponent += 128;
  361.  
  362.   /* assemble 1st word (seeeeeeeemmmmmmm): */
  363.  
  364.                                          /* discard highest mantissa bit 55 (implicit leading one) */
  365.   p_dest[0] = (((Word)dissect.negative & 1) << 15)
  366.             | ((dissect.exponent << 7) & 0x7f80u)
  367.             | as_float_mantissa_extract(&dissect,  1,  7); /* mant bits 54...48 */
  368.   p_dest[1] = as_float_mantissa_extract(&dissect,  8, 16); /* mant bits 47...32 */
  369.   p_dest[2] = as_float_mantissa_extract(&dissect, 24, 16); /* mant bits 31...24 */
  370.   p_dest[3] = as_float_mantissa_extract(&dissect, 40, 16); /* mant bits 15... 0 */
  371.  
  372. #endif /* HOST_DECFLOAT && !__GFLOAT */
  373.  
  374.   return 4;
  375. }
  376.  
  377. /*!------------------------------------------------------------------------
  378.  * \fn     as_float_2_dec_g(as_float_t inp, Word *p_dest)
  379.  * \brief  convert from host to DEC (VAX) 8 byte float (G) format
  380.  * \param  inp value to dispose
  381.  * \param  p_dest where to dispose
  382.  * \return >0 for number of words used (4) or <0 for error code
  383.  * ------------------------------------------------------------------------ */
  384.  
  385. int as_float_2_dec_g(as_float_t inp, Word *p_dest)
  386. {
  387. #if (defined HOST_DECFLOAT) && (defined __GFLOAT)
  388.   double tmp;
  389.  
  390.   /* native format: */
  391.   tmp = inp;
  392.   memcpy(p_dest, &tmp, 8);
  393.  
  394. #else /* !HOST_DECFLOAT || !__GFLOAT*/
  395.  
  396.   as_float_dissect_t dissect;
  397.  
  398.   /* Dissect */
  399.  
  400.   as_float_dissect(&dissect, inp);
  401.  
  402.   /* Inf/NaN cannot be represented in target format: */
  403.  
  404.   if ((dissect.fp_class != AS_FP_NORMAL)
  405.    && (dissect.fp_class != AS_FP_SUBNORMAL))
  406.     return -EINVAL;
  407.  
  408.   as_float_round(&dissect, 53);
  409.  
  410.   /* For DEC float, Mantissa is in range 0.5...1.0, instead of 1.0...2.0: */
  411.  
  412.   dissect.exponent++;
  413.   if (dissect.exponent > 1023)
  414.     return -E2BIG;
  415.  
  416.   /* DEC float does not handle denormal numbers and truncates to zero: */
  417.  
  418.   if (dissect.fp_class == AS_FP_SUBNORMAL)
  419.   {
  420.     dissect.exponent = -1024;
  421.     memset(dissect.mantissa, 0, sizeof dissect.mantissa);
  422.   }
  423.  
  424.   /* add bias to exponent */
  425.  
  426.   dissect.exponent += 1024;
  427.  
  428.   /* assemble 1st word (seeeeeeeeeeemmmm): */
  429.  
  430.                                          /* discard highest mantissa bit 52 (implicit leading one) */
  431.   p_dest[0] = (((Word)dissect.negative & 1) << 15)
  432.             | ((dissect.exponent << 4) & 0x7ff0u)
  433.             | as_float_mantissa_extract(&dissect,  1,  4); /* mant bits 51...48 */
  434.   p_dest[1] = as_float_mantissa_extract(&dissect,  5, 16); /* mant bits 47...32 */
  435.   p_dest[2] = as_float_mantissa_extract(&dissect, 21, 16); /* mant bits 31...16 */
  436.   p_dest[3] = as_float_mantissa_extract(&dissect, 37, 16); /* mant bits 15... 0 */
  437.  
  438. #endif /* HOST_DECFLOAT && __GFLOAT */
  439.  
  440.   return 4;
  441. }
  442.  
  443. /*!------------------------------------------------------------------------
  444.  * \fn     as_float_2_dec_h(as_float_t inp, Word *p_dest)
  445.  * \brief  convert from host to DEC (VAX) 16 byte float (h) format
  446.  * \param  inp value to dispose
  447.  * \param  p_dest where to dispose
  448.  * \return >0 for number of words used (8) or <0 for error code
  449.  * ------------------------------------------------------------------------ */
  450.  
  451. int as_float_2_dec_h(as_float_t inp, Word *p_dest)
  452. {
  453.   as_float_dissect_t dissect;
  454.  
  455.   /* Dissect */
  456.  
  457.   as_float_dissect(&dissect, inp);
  458.  
  459.   /* Inf/NaN cannot be represented in target format: */
  460.  
  461.   if ((dissect.fp_class != AS_FP_NORMAL)
  462.    && (dissect.fp_class != AS_FP_SUBNORMAL))
  463.     return -EINVAL;
  464.  
  465.   as_float_round(&dissect, 113);
  466.  
  467.   /* For DEC float, Mantissa is in range 0.5...1.0, instead of 1.0...2.0: */
  468.  
  469.   dissect.exponent++;
  470.   if (dissect.exponent > 16383)
  471.     return -E2BIG;
  472.  
  473.   /* DEC float does not handle denormal numbers and truncates to zero: */
  474.  
  475.   if (dissect.fp_class == AS_FP_SUBNORMAL)
  476.   {
  477.     dissect.exponent = -16384;
  478.     memset(dissect.mantissa, 0, sizeof dissect.mantissa);
  479.   }
  480.  
  481.   /* add bias to exponent */
  482.  
  483.   dissect.exponent += 16384;
  484.  
  485.   /* assemble 1st word (seeeeeeeeeeeeeee): */
  486.  
  487.   p_dest[0] = (((Word)dissect.negative & 1) << 15)
  488.             | ((dissect.exponent << 0) & 0x7fffu);
  489.                                          /* discard highest mantissa bit 112 (implicit leading one) */
  490.   p_dest[1] = as_float_mantissa_extract(&dissect,  1, 16); /* mant bits 111...96 */
  491.   p_dest[2] = as_float_mantissa_extract(&dissect, 17, 16); /* mant bits  95...80 */
  492.   p_dest[3] = as_float_mantissa_extract(&dissect, 33, 16); /* mant bits  79...64 */
  493.   p_dest[4] = as_float_mantissa_extract(&dissect, 49, 16); /* mant bits  63...48 */
  494.   p_dest[5] = as_float_mantissa_extract(&dissect, 65, 16); /* mant bits  47...32 */
  495.   p_dest[6] = as_float_mantissa_extract(&dissect, 81, 16); /* mant bits  31...16 */
  496.   p_dest[7] = as_float_mantissa_extract(&dissect, 97, 16); /* mant bits  15... 0 */
  497.  
  498.   return 8;
  499. }
  500.