Details | Last modification | View Log | RSS feed
| Rev | Author | Line No. | Line |
|---|---|---|---|
| 1126 | savelij | 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 | } |