Subversion Repositories pentevo

Rev

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

  1. /* aplfloat.c */
  2. /*****************************************************************************/
  3. /* SPDX-License-Identifier: GPL-2.0-only OR GPL-3.0-only                     */
  4. /*                                                                           */
  5. /* AS                                                                        */
  6. /*                                                                           */
  7. /* APPLE<->IEEE Floating Point Conversion on host                            */
  8. /*                                                                           */
  9. /*****************************************************************************/
  10.  
  11. #include "stdinc.h"
  12. #include <errno.h>
  13.  
  14. #include "errmsg.h"
  15. #include "asmerr.h"
  16. #include "strcomp.h"
  17. #include "ieeefloat.h"
  18. #include "aplfloat.h"
  19.  
  20. /*!------------------------------------------------------------------------
  21.  * \fn     Double_2_apl4(Double inp, Word *p_dest)
  22.  * \brief  convert from host to Apple II 4 byte float format
  23.  * \param  inp value to dispose
  24.  * \param  p_dest where to dispose
  25.  * \return 0 or error code
  26.  * ------------------------------------------------------------------------ */
  27.  
  28. int Double_2_apl4(Double inp, Word *p_dest)
  29. {
  30.   Word sign;
  31.   Integer exponent;
  32.   LongWord mantissa, fraction;
  33.   Boolean round_up;
  34.  
  35.   /* Dissect IEEE number.  (Absolute of) mantissa is already in range 2.0 > M >= 1.0,
  36.      unless denormal. NaN and Infinity cannot be represented: */
  37.  
  38.   ieee8_dissect(&sign, &exponent, &mantissa, &fraction, inp);
  39.   if (exponent == 2047)
  40.     return EINVAL;
  41.  
  42.   /* (3) Denormalize small numbers: */
  43.  
  44. #if 0
  45.   printf("0x%08x 0x%08x\n", (unsigned)mantissa, (unsigned)fraction);
  46. #endif
  47.   while ((exponent < -128) && (mantissa || fraction))
  48.   {
  49.     mantissa++;
  50.     fraction = ((fraction >> 1) & 0x7ffffful) | ((mantissa & 1) ? 0x800000ul : 0x000000ul);
  51.     mantissa = (mantissa >> 1) & 0x1fffffful;
  52.   }
  53.  
  54.   /* Two's Complement of mantissa. Note mantissa afterwards has 30 bits, including sign: */
  55.  
  56.   if (sign)
  57.   {
  58.     fraction = fraction ^ 0x00fffffful;
  59.     mantissa = mantissa ^ 0x7ffffffful;
  60.     if (++fraction >= 0x01000000ul)
  61.     {
  62.       fraction = 0;
  63.       mantissa = (mantissa + 1) & 0x7ffffffful;
  64.      
  65.     }
  66.   }
  67.  
  68.   /* Normalize, so that topmost bits of mantissa are unequal.  This happens
  69.      for powers of two, after negating:  */
  70.  
  71.   switch ((mantissa >> 28) & 3)
  72.   {
  73.     case 0:
  74.     case 3:
  75.       exponent--;
  76.       mantissa = ((mantissa << 1) & 0x7ffffffeul) | ((fraction >> 23) & 1);
  77.       fraction = (fraction << 1) & 0xfffffful;
  78.       break;
  79.   }
  80.  
  81.   /* (4) Round mantissa.  The mantissa currently has 30 bits, and - including sign - we
  82.          will use 24 of them.  So the "half LSB" bit to look at is bit 5: */
  83.  
  84.   if (mantissa & 0x20) /* >= 0.5 */
  85.   {
  86.     if ((mantissa & 0x1f) || fraction) /* > 0.5 */
  87.       round_up = True;
  88.     else /* == 0.5 */
  89.       round_up = !!(mantissa & 0x40); /* round towards even */
  90.   }
  91.   else /* < 0.5 */
  92.     round_up = False;
  93.  
  94.   if (round_up)
  95.   {
  96.     LongWord new_mantissa = mantissa + 0x40;
  97.  
  98.     /* overflow during round-up? */
  99.  
  100.     if ((new_mantissa ^ mantissa) & 0x40000000ul)
  101.     {
  102.       /* arithmetic right shift, preserving sign */
  103.       mantissa = (mantissa & 0x40000000ul) | ((mantissa >> 1) & 0x3ffffffful);
  104.       exponent++;
  105.     }
  106.     mantissa += 0x40;
  107.   }
  108.  
  109.   /* After knowing final exponent, check for overflow: */
  110.  
  111.   if (exponent > 127)
  112.     return E2BIG;
  113.  
  114.   /* (5) mantissa zero means exponent is also zero */
  115.  
  116.   if (!mantissa)
  117.     exponent = 0;
  118.  
  119.   /* (7) Assemble: */
  120.  
  121.   p_dest[0] = (((exponent + 128) << 8) & 0xff00ul) | ((mantissa >> 22) & 0x00fful);
  122.   p_dest[1] = (mantissa >> 6) & 0xfffful;
  123.   return 0;
  124. }
  125.  
  126. /*!------------------------------------------------------------------------
  127.  * \fn     check_apl_fp_dispose_result(int ret, const struct sStrComp *p_arg)
  128.  * \brief  check the result of Double_2... and throw associated error messages
  129.  * \param  ret return code
  130.  * \param  p_arg associated source argument
  131.  * ------------------------------------------------------------------------ */
  132.  
  133. Boolean check_apl_fp_dispose_result(int ret, const struct sStrComp *p_arg)
  134. {
  135.   switch (ret)
  136.   {
  137.     case 0:
  138.       return True;
  139.     case E2BIG:
  140.       WrStrErrorPos(ErrNum_OverRange, p_arg);
  141.       return False;
  142.     default:
  143.       WrXErrorPos(ErrNum_InvArg, "INF/NaN", &p_arg->Pos);
  144.       return False;
  145.   }
  146. }
  147.