home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / src / ffloat.d < prev    next >
Encoding:
Text File  |  1996-04-15  |  36.3 KB  |  880 lines
  1. # Grundfunktionen für Single-Floats
  2.  
  3. # Entpacken eines Single-Float:
  4. # FF_decode(obj, zero_statement, sign=,exp=,mant=);
  5. # zerlegt ein Single-Float obj.
  6. # Ist obj=0.0, wird zero_statement ausgeführt.
  7. # Sonst: signean sign = Vorzeichen (0 = +, -1 = -),
  8. #        sintWL exp = Exponent (vorzeichenbehaftet),
  9. #        uintL mant = Mantisse (>= 2^FF_mant_len, < 2^(FF_mant_len+1))
  10.   #define FF_uexp(x)  (((x) >> FF_mant_len) & (bit(FF_exp_len)-1))
  11.   #define FF_decode(obj, zero_statement, sign_zuweisung,exp_zuweisung,mant_zuweisung)  \
  12.     { var reg1 ffloat _x = ffloat_value(obj);                                \
  13.       var reg2 uintBWL uexp = FF_uexp(_x);                                   \
  14.       if (uexp==0)                                                           \
  15.         { zero_statement } # e=0 -> Zahl 0.0                                 \
  16.         else                                                                 \
  17.         { exp_zuweisung (sintWL)((uintWL)uexp - FF_exp_mid); # Exponent      \
  18.           unused (sign_zuweisung sign_of_sint32((sint32)(_x))); # Vorzeichen \
  19.           mant_zuweisung (bit(FF_mant_len) | (_x & (bit(FF_mant_len)-1)));   \
  20.     }   }
  21.  
  22. # Einpacken eines Single-Float:
  23. # encode_FF(sign,exp,mant, ergebnis=);
  24. # liefert ein Single-Float.
  25. # > signean sign: Vorzeichen, 0 für +, -1 für negativ.
  26. # > sintWL exp: Exponent
  27. # > uintL mant: Mantisse, sollte >= 2^FF_mant_len und < 2^(FF_mant_len+1) sein.
  28. # < object ergebnis: ein Single-Float
  29. # Der Exponent wird auf Überlauf/Unterlauf getestet.
  30. # kann GC auslösen
  31.   #define encode_FF(sign,exp,mant, erg_zuweisung)  \
  32.     { if ((exp) < (sintWL)(FF_exp_low-FF_exp_mid))                  \
  33.         { if (underflow_allowed())                                  \
  34.             { fehler_underflow(); }                                 \
  35.             else                                                    \
  36.             { erg_zuweisung FF_0; }                                 \
  37.         }                                                           \
  38.       else                                                          \
  39.       if ((exp) > (sintWL)(FF_exp_high-FF_exp_mid))                 \
  40.         { fehler_overflow(); }                                      \
  41.       else                                                          \
  42.       erg_zuweisung allocate_ffloat                                 \
  43.         (  ((sint32)(sign) & bit(31))                  # Vorzeichen \
  44.          | ((uint32)((exp)+FF_exp_mid) << FF_mant_len) # Exponent   \
  45.          | ((uint32)(mant) & (bit(FF_mant_len)-1))     # Mantisse   \
  46.         );                                                          \
  47.     }
  48.  
  49. #ifdef FAST_FLOAT
  50. # Auspacken eines Floats:
  51.   #ifndef WIDE
  52.     #define FF_to_float(obj)  (TheFfloat(obj)->representation.machine_float)
  53.   #else # defined(WIDE) -> eines der beiden 32-Bit-Wörter
  54.     #ifdef GNU
  55.       #define FF_to_float(obj)  (((ffloatjanus) { explicit_: ffloat_value(obj) }).machine_float)
  56.     #else
  57.       #define FF_to_float(obj)  (*(float*)(&((uint32*)&(obj))[BIG_ENDIAN_P+(1-2*BIG_ENDIAN_P)*(oint_data_shift/32)]))
  58.     #endif
  59.   #endif
  60. # Überprüfen und Einpacken eines von den 'float'-Routinen gelieferten
  61. # IEEE-Floats.
  62. # Klassifikation:
  63. #   1 <= e <= 254 : normalisierte Zahl
  64. #   e=0, m/=0: subnormale Zahl
  65. #   e=0, m=0: vorzeichenbehaftete 0.0
  66. #   e=255, m=0: vorzeichenbehaftete Infinity
  67. #   e=255, m/=0: NaN
  68. # Angabe der möglicherweise auftretenden Sonderfälle:
  69. #   maybe_overflow: Operation läuft über, liefert IEEE-Infinity
  70. #   maybe_subnormal: Ergebnis sehr klein, liefert IEEE-subnormale Zahl
  71. #   maybe_underflow: Ergebnis sehr klein und /=0, liefert IEEE-Null
  72. #   maybe_divide_0: Ergebnis unbestimmt, liefert IEEE-Infinity
  73. #   maybe_nan: Ergebnis unbestimmt, liefert IEEE-NaN
  74.   #define float_to_FF(expr,ergebnis_zuweisung,maybe_overflow,maybe_subnormal,maybe_underflow,maybe_divide_0,maybe_nan)  \
  75.     { var ffloatjanus _erg; _erg.machine_float = (expr);            \
  76.       if ((_erg.explicit_ & ((uint32)bit(FF_exp_len+FF_mant_len)-bit(FF_mant_len))) == 0) # e=0 ? \
  77.         { if ((maybe_underflow                                      \
  78.                || (maybe_subnormal && !((_erg.explicit_ << 1) == 0)) \
  79.               )                                                     \
  80.               && underflow_allowed()                                \
  81.              )                                                      \
  82.             { fehler_underflow(); } # subnormal oder noch kleiner-> Underflow \
  83.             else                                                    \
  84.             { ergebnis_zuweisung FF_0; } # +/- 0.0 -> 0.0           \
  85.         }                                                           \
  86.       elif ((maybe_overflow || maybe_divide_0)                      \
  87.             && (((~_erg.explicit_) & ((uint32)bit(FF_exp_len+FF_mant_len)-bit(FF_mant_len))) == 0) # e=255 ? \
  88.            )                                                        \
  89.         { if (maybe_nan && !((_erg.explicit_ << (32-FF_mant_len)) == 0)) \
  90.             { divide_0(); } # NaN, also Singularität -> "Division durch 0" \
  91.           else # Infinity                                           \
  92.           if (!maybe_overflow || maybe_divide_0)                    \
  93.             { divide_0(); } # Infinity, Division durch 0            \
  94.             else                                                    \
  95.             { fehler_overflow(); } # Infinity, Overflow             \
  96.         }                                                           \
  97.       else                                                          \
  98.         { ergebnis_zuweisung allocate_ffloat(_erg.explicit_); }      \
  99.     }
  100. #endif
  101.  
  102. # FF_zerop(x) stellt fest, ob ein Single-Float x = 0.0 ist.
  103.   # define FF_zerop(x)  (FF_uexp(ffloat_value(x)) == 0)
  104.   #define FF_zerop(x)  (ffloat_value(x) == 0)
  105.  
  106. # Liefert zu einem Single-Float x : (ftruncate x), ein FF.
  107. # FF_ftruncate_FF(x)
  108. # x wird zur 0 hin zur nächsten ganzen Zahl gerundet.
  109. # kann GC auslösen
  110.   local object FF_ftruncate_FF (object x);
  111. # Methode:
  112. # x = 0.0 oder e<=0 -> Ergebnis 0.0
  113. # 1<=e<=23 -> letzte (24-e) Bits der Mantisse auf 0 setzen,
  114. #             Exponent und Vorzeichen beibehalten
  115. # e>=24 -> Ergebnis x
  116.   local object FF_ftruncate_FF(x)
  117.     var reg3 object x;
  118.     { var reg2 ffloat x_ = ffloat_value(x);
  119.       var reg1 uintBWL uexp = FF_uexp(x_); # e + FF_exp_mid
  120.       if (uexp <= FF_exp_mid) # 0.0 oder e<=0 ?
  121.         { return FF_0; }
  122.         else
  123.         { if (uexp > FF_exp_mid+FF_mant_len) # e > 23 ?
  124.             { return x; }
  125.             else
  126.             { return allocate_ffloat
  127.                 ( x_ & # Bitmaske: Bits 23-e..0 gelöscht, alle anderen gesetzt
  128.                   ~(bit(FF_mant_len+1+FF_exp_mid-uexp)-1)
  129.                 );
  130.     }   }   }
  131.  
  132. # Liefert zu einem Single-Float x : (futruncate x), ein FF.
  133. # FF_futruncate_FF(x)
  134. # x wird von der 0 weg zur nächsten ganzen Zahl gerundet.
  135. # kann GC auslösen
  136.   local object FF_futruncate_FF (object x);
  137. # Methode:
  138. # x = 0.0 -> Ergebnis 0.0
  139. # e<=0 -> Ergebnis 1.0 oder -1.0, je nach Vorzeichen von x.
  140. # 1<=e<=23 -> Greife die letzten (24-e) Bits von x heraus.
  141. #             Sind sie alle =0 -> Ergebnis x.
  142. #             Sonst setze sie alle und erhöhe dann die letzte Stelle um 1.
  143. #             Kein Überlauf der 23 Bit -> fertig.
  144. #             Sonst (Ergebnis eine Zweierpotenz): Mantisse := .1000...000,
  145. #               e:=e+1. (Test auf Überlauf wegen e<=24 überflüssig)
  146. # e>=24 -> Ergebnis x.
  147.   local object FF_futruncate_FF(x)
  148.     var reg3 object x;
  149.     { var reg2 ffloat x_ = ffloat_value(x);
  150.       var reg1 uintBWL uexp = FF_uexp(x_); # e + FF_exp_mid
  151.       if (uexp==0) # 0.0 ?
  152.         { return x; }
  153.       if (uexp <= FF_exp_mid) # e<=0 ?
  154.         { # Exponent auf 1, Mantisse auf .1000...000 setzen.
  155.           return ((x_ & bit(31))==0 ? FF_1 : FF_minus1);
  156.         }
  157.         else
  158.         { if (uexp > FF_exp_mid+FF_mant_len) # e > 23 ?
  159.             { return x; }
  160.             else
  161.             { var reg1 uint32 mask = # Bitmaske: Bits 23-e..0 gesetzt, alle anderen gelöscht
  162.                 bit(FF_mant_len+1+FF_exp_mid-uexp)-1;
  163.               if ((x_ & mask)==0) # alle diese Bits =0 ?
  164.                 { return x; }
  165.               return allocate_ffloat
  166.                 ((x_ | mask) # alle diese Bits setzen
  167.                  + 1 # letzte Stelle erhöhen, dabei evtl. Exponenten incrementieren
  168.                 );
  169.     }   }   }
  170.  
  171. # Liefert zu einem Single-Float x : (fround x), ein FF.
  172. # FF_fround_FF(x)
  173. # x wird zur nächsten ganzen Zahl gerundet.
  174. # kann GC auslösen
  175.   local object FF_fround_FF (object x);
  176. # Methode:
  177. # x = 0.0 oder e<0 -> Ergebnis 0.0
  178. # 0<=e<=23 -> letzte (24-e) Bits der Mantisse wegrunden,
  179. #             Exponent und Vorzeichen beibehalten.
  180. # e>23 -> Ergebnis x
  181.   local object FF_fround_FF(x)
  182.     var reg3 object x;
  183.     { var reg2 ffloat x_ = ffloat_value(x);
  184.       var reg1 uintBWL uexp = FF_uexp(x_); # e + FF_exp_mid
  185.       if (uexp < FF_exp_mid) # x = 0.0 oder e<0 ?
  186.         { return FF_0; }
  187.         else
  188.         { if (uexp > FF_exp_mid+FF_mant_len) # e > 23 ?
  189.             { return x; }
  190.             else
  191.             if (uexp > FF_exp_mid+1) # e>1 ?
  192.               { var reg4 uint32 bitmask = # Bitmaske: Bit 23-e gesetzt, alle anderen gelöscht
  193.                   bit(FF_mant_len+FF_exp_mid-uexp);
  194.                 var reg3 uint32 mask = # Bitmaske: Bits 22-e..0 gesetzt, alle anderen gelöscht
  195.                   bitmask-1;
  196.                 if ( ((x_ & bitmask) ==0) # Bit 23-e =0 -> abrunden
  197.                      || ( ((x_ & mask) ==0) # Bit 23-e =1 und Bits 22-e..0 >0 -> aufrunden
  198.                           # round-to-even, je nach Bit 24-e :
  199.                           && ((x_ & (bitmask<<1)) ==0)
  200.                    )    )
  201.                   # abrunden
  202.                   { mask |= bitmask; # Bitmaske: Bits 23-e..0 gesetzt, alle anderen gelöscht
  203.                     return allocate_ffloat( x_ & ~mask );
  204.                   }
  205.                   else
  206.                   # aufrunden
  207.                   { return allocate_ffloat
  208.                       ((x_ | mask) # alle diese Bits 22-e..0 setzen (Bit 23-e schon gesetzt)
  209.                        + 1 # letzte Stelle erhöhen, dabei evtl. Exponenten incrementieren
  210.                       );
  211.                   }
  212.               }
  213.             elif (uexp == FF_exp_mid+1) # e=1 ?
  214.               # Wie bei 1 < e <= 23, nur daß Bit 24-e stets gesetzt ist.
  215.               { if ((x_ & bit(FF_mant_len-1)) ==0) # Bit 23-e =0 -> abrunden
  216.                   # abrunden
  217.                   { return allocate_ffloat( x_ & ~(bit(FF_mant_len)-1) ); }
  218.                   else
  219.                   # aufrunden
  220.                   { return allocate_ffloat
  221.                       ((x_ | (bit(FF_mant_len)-1)) # alle diese Bits 23-e..0 setzen
  222.                        + 1 # letzte Stelle erhöhen, dabei evtl. Exponenten incrementieren
  223.                       );
  224.                   }
  225.               }
  226.             else # e=0 ?
  227.               # Wie bei 1 < e <= 23, nur daß Bit 23-e stets gesetzt
  228.               # und Bit 24-e stets gelöscht ist.
  229.               { if ((x_ & (bit(FF_mant_len)-1)) ==0)
  230.                   # abrunden von +-0.5 zu 0.0
  231.                   { return FF_0; }
  232.                   else
  233.                   # aufrunden
  234.                   { return allocate_ffloat
  235.                       ((x_ | (bit(FF_mant_len)-1)) # alle Bits 22-e..0 setzen
  236.                        + 1 # letzte Stelle erhöhen, dabei Exponenten incrementieren
  237.                       );
  238.               }   }
  239.     }   }
  240.  
  241. # Liefert zu einem Single-Float x : (- x), ein FF.
  242. # FF_minus_FF(x)
  243. # kann GC auslösen
  244.   local object FF_minus_FF (object x);
  245. # Methode:
  246. # Falls x=0.0, fertig. Sonst Vorzeichenbit umdrehen.
  247.   local object FF_minus_FF(x)
  248.     var reg2 object x;
  249.     { var reg1 ffloat x_ = ffloat_value(x);
  250.       return (FF_uexp(x_) == 0
  251.               ? x
  252.               : allocate_ffloat( x_ ^ bit(31) )
  253.              );
  254.     }
  255.  
  256. # FF_FF_comp(x,y) vergleicht zwei Single-Floats x und y.
  257. # Ergebnis: 0 falls x=y, +1 falls x>y, -1 falls x<y.
  258.   local signean FF_FF_comp (object x, object y);
  259. # Methode:
  260. # x und y haben verschiedenes Vorzeichen ->
  261. #    x < 0 -> x < y
  262. #    x >= 0 -> x > y
  263. # x und y haben gleiches Vorzeichen ->
  264. #    x >=0 -> vergleiche x und y (die rechten 24 Bits)
  265. #    x <0 -> vergleiche y und x (die rechten 24 Bits)
  266.   local signean FF_FF_comp(x,y)
  267.     var reg3 object x;
  268.     var reg4 object y;
  269.     { var reg1 uint32 x_ = ffloat_value(x);
  270.       var reg2 uint32 y_ = ffloat_value(y);
  271.       if ((sint32)y_ >= 0)
  272.         # y>=0
  273.         { if ((sint32)x_ >= 0)
  274.             # y>=0, x>=0
  275.             { if (x_ < y_) return signean_minus; # x<y
  276.               if (x_ > y_) return signean_plus; # x>y
  277.               return signean_null;
  278.             }
  279.             else
  280.             # y>=0, x<0
  281.             { return signean_minus; } # x<y
  282.         }
  283.         else
  284.         { if ((sint32)x_ >= 0)
  285.             # y<0, x>=0
  286.             { return signean_plus; } # x>y
  287.             else
  288.             # y<0, x<0
  289.             { if (x_ > y_) return signean_minus; # |x|>|y| -> x<y
  290.               if (x_ < y_) return signean_plus; # |x|<|y| -> x>y
  291.               return signean_null;
  292.             }
  293.         }
  294.     }
  295.  
  296. # Liefert zu zwei Single-Float x und y : (+ x y), ein FF.
  297. # FF_FF_plus_FF(x,y)
  298. # kann GC auslösen
  299.   local object FF_FF_plus_FF (object x, object y);
  300. # Methode (nach [Knuth, II, Seminumerical Algorithms, Abschnitt 4.2.1., S.200]):
  301. # x1=0.0 -> Ergebnis x2.
  302. # x2=0.0 -> Ergebnis x1.
  303. # Falls e1<e2, vertausche x1 und x2.
  304. # Also e1 >= e2.
  305. # Falls e1 - e2 >= 23 + 3, Ergebnis x1.
  306. # Schiebe beide Mantissen um 3 Bits nach links (Vorbereitung der Rundung:
  307. #   Bei e1-e2=0,1 ist keine Rundung nötig, bei e1-e2>1 ist der Exponent des
  308. #   Ergebnisses =e1-1, =e1 oder =e1+1. Brauche daher 1 Schutzbit und zwei
  309. #   Rundungsbits: 00 exakt, 01 1.Hälfte, 10 exakte Mitte, 11 2.Hälfte.)
  310. # Schiebe die Mantisse von x2 um e0-e1 Bits nach rechts. (Dabei die Rundung
  311. # ausführen: Bit 0 ist das logische Oder der Bits 0,-1,-2,...)
  312. # Falls x1,x2 selbes Vorzeichen haben: Addiere dieses zur Mantisse von x1.
  313. # Falls x1,x2 verschiedenes Vorzeichen haben: Subtrahiere dieses von der
  314. #   Mantisse von x1. <0 -> (Es war e1=e2) Vertausche die Vorzeichen, negiere.
  315. #                    =0 -> Ergebnis 0.0
  316. # Exponent ist e1.
  317. # Normalisiere, fertig.
  318.  #ifdef FAST_FLOAT
  319.   local object FF_FF_plus_FF(x1,x2)
  320.     var reg1 object x1;
  321.     var reg2 object x2;
  322.     { float_to_FF(FF_to_float(x1) + FF_to_float(x2), return ,
  323.                   TRUE, TRUE, # Overflow und subnormale Zahl abfangen
  324.                   FALSE, # kein Underflow mit Ergebnis +/- 0.0 möglich
  325.                          # (nach Definition der subnormalen Zahlen)
  326.                   FALSE, FALSE # keine Singularität, kein NaN als Ergebnis möglich
  327.                  );
  328.     }
  329.  #else
  330.   local object FF_FF_plus_FF(x1,x2)
  331.     var reg7 object x1;
  332.     var reg8 object x2;
  333.     { # x1,x2 entpacken:
  334.       var reg9 signean sign1;
  335.       var reg5 sintWL exp1;
  336.       var reg1 uintL mant1;
  337.       var reg9 signean sign2;
  338.       var reg10 sintWL exp2;
  339.       var reg4 uintL mant2;
  340.       FF_decode(x1, { return x2; }, sign1=,exp1=,mant1=);
  341.       FF_decode(x2, { return x1; }, sign2=,exp2=,mant2=);
  342.       if (exp1 < exp2)
  343.         { swap(reg9 object,  x1   ,x2   );
  344.           swap(reg9 signean, sign1,sign2);
  345.           swap(reg9 sintWL,  exp1 ,exp2 );
  346.           swap(reg9 uintL,   mant1,mant2);
  347.         }
  348.       # Nun ist exp1>=exp2.
  349.      {var reg3 uintL expdiff = exp1 - exp2; # Exponentendifferenz
  350.       if (expdiff >= FF_mant_len+3) # >= 23+3 ?
  351.         { return x1; }
  352.       mant1 = mant1 << 3; mant2 = mant2 << 3;
  353.       # Nun 2^(FF_mant_len+3) <= mant1,mant2 < 2^(FF_mant_len+4).
  354.       {var reg2 uintL mant2_last = mant2 & (bit(expdiff)-1); # letzte expdiff Bits von mant2
  355.        mant2 = mant2 >> expdiff; if (!(mant2_last==0)) { mant2 |= bit(0); }
  356.       }
  357.       # mant2 = um expdiff Bits nach rechts geschobene und gerundete Mantisse
  358.       # von x2.
  359.       if (!(sign1==sign2))
  360.         # verschiedene Vorzeichen -> Mantissen subtrahieren
  361.         { if (mant1 > mant2) { mant1 = mant1 - mant2; goto norm_2; }
  362.           if (mant1 == mant2) # Ergebnis 0 ?
  363.             { return FF_0; }
  364.           # negatives Subtraktionsergebnis
  365.           mant1 = mant2 - mant1; sign1 = sign2; goto norm_2;
  366.         }
  367.         else
  368.         # gleiche Vorzeichen -> Mantissen addieren
  369.         { mant1 = mant1 + mant2; }
  370.       # mant1 = Ergebnis-Mantisse >0, sign1 = Ergebnis-Vorzeichen,
  371.       # exp1 = Ergebnis-Exponent.
  372.       # Außerdem: Bei expdiff=0,1 sind die zwei letzten Bits von mant1 Null,
  373.       # bei expdiff>=2 ist mant1 >= 2^(FF_mant_len+2).
  374.       # Stets ist mant1 < 2^(FF_mant_len+5). (Daher werden die 2 Rundungsbits
  375.       # nachher um höchstens eine Position nach links geschoben werden.)
  376.       # [Knuth, S.201, leicht modifiziert:
  377.       #   N1. m>=1 -> goto N4.
  378.       #   N2. [Hier m<1] m>=1/2 -> goto N5.
  379.       #       N3. m:=2*m, e:=e-1, goto N2.
  380.       #   N4. [Hier 1<=m<2] m:=m/2, e:=e+1.
  381.       #   N5. [Hier 1/2<=m<1] Runde m auf 24 Bits hinterm Komma.
  382.       #       Falls hierdurch m=1 geworden, setze m:=m/2, e:=e+1.
  383.       # ]
  384.       # Bei uns ist m=mant1/2^(FF_mant_len+4),
  385.       # ab Schritt N5 ist m=mant1/2^(FF_mant_len+1).
  386.       norm_1: # [Knuth, S.201, Schritt N1]
  387.       if (mant1 >= bit(FF_mant_len+4)) goto norm_4;
  388.       norm_2: # [Knuth, S.201, Schritt N2]
  389.               # Hier ist mant1 < 2^(FF_mant_len+4)
  390.       if (mant1 >= bit(FF_mant_len+3)) goto norm_5;
  391.       # [Knuth, S.201, Schritt N3]
  392.       mant1 = mant1 << 1; exp1 = exp1-1; # Mantisse links schieben
  393.       goto norm_2;
  394.       norm_4: # [Knuth, S.201, Schritt N4]
  395.               # Hier ist 2^(FF_mant_len+4) <= mant1 < 2^(FF_mant_len+5)
  396.       exp1 = exp1+1;
  397.       mant1 = (mant1>>1) | (mant1 & bit(0)); # Mantisse rechts schieben
  398.       norm_5: # [Knuth, S.201, Schritt N5]
  399.               # Hier ist 2^(FF_mant_len+3) <= mant1 < 2^(FF_mant_len+4)
  400.       # Auf FF_mant_len echte Mantissenbits runden, d.h. rechte 3 Bits
  401.       # wegrunden, und dabei mant1 um 3 Bits nach rechts schieben:
  402.       {var reg2 uintL rounding_bits = mant1 & (bit(3)-1);
  403.        mant1 = mant1 >> 3;
  404.        if ( (rounding_bits < bit(2)) # 000,001,010,011 werden abgerundet
  405.             || ( (rounding_bits == bit(2)) # 100 (genau halbzahlig)
  406.                  && ((mant1 & bit(0)) ==0) # -> round-to-even
  407.           )    )
  408.          # abrunden
  409.          {}
  410.          else
  411.          # aufrunden
  412.          { mant1 = mant1+1;
  413.            if (mant1 >= bit(FF_mant_len+1))
  414.              # Bei Überlauf während der Rundung nochmals rechts schieben
  415.              # (Runden ist hier überflüssig):
  416.              { mant1 = mant1>>1; exp1 = exp1+1; } # Mantisse rechts schieben
  417.          }
  418.       }# Runden fertig
  419.       encode_FF(sign1,exp1,mant1, return);
  420.     }}
  421.  #endif
  422.  
  423. # Liefert zu zwei Single-Float x und y : (- x y), ein FF.
  424. # FF_FF_minus_FF(x,y)
  425. # kann GC auslösen
  426.   local object FF_FF_minus_FF (object x, object y);
  427. # Methode:
  428. # (- x1 x2) = (+ x1 (- x2))
  429.  #ifdef FAST_FLOAT
  430.   local object FF_FF_minus_FF(x1,x2)
  431.     var reg1 object x1;
  432.     var reg2 object x2;
  433.     { float_to_FF(FF_to_float(x1) - FF_to_float(x2), return ,
  434.                   TRUE, TRUE, # Overflow und subnormale Zahl abfangen
  435.                   FALSE, # kein Underflow mit Ergebnis +/- 0.0 möglich
  436.                          # (nach Definition der subnormalen Zahlen)
  437.                   FALSE, FALSE # keine Singularität, kein NaN als Ergebnis möglich
  438.                  );
  439.     }
  440.  #else
  441.   local object FF_FF_minus_FF(x1,x2)
  442.     var reg3 object x1;
  443.     var reg1 object x2;
  444.     { var reg2 ffloat x2_ = ffloat_value(x2);
  445.       if (FF_uexp(x2_) == 0)
  446.         { return x1; }
  447.         else
  448.         { pushSTACK(x1);
  449.           x2 = allocate_ffloat(x2_ ^ bit(31));
  450.           return FF_FF_plus_FF(popSTACK(),x2);
  451.     }   }
  452.  #endif
  453.  
  454. # Liefert zu zwei Single-Float x und y : (* x y), ein FF.
  455. # FF_FF_mal_FF(x,y)
  456. # kann GC auslösen
  457.   local object FF_FF_mal_FF (object x, object y);
  458. # Methode:
  459. # Falls x1=0.0 oder x2=0.0 -> Ergebnis 0.0
  460. # Sonst: Ergebnis-Vorzeichen = VZ von x1 xor VZ von x2.
  461. #        Ergebnis-Exponent = Summe der Exponenten von x1 und x2.
  462. #        Ergebnis-Mantisse = Produkt der Mantissen von x1 und x2, gerundet:
  463. #          2^-24 * mant1  *  2^-24 * mant2  =  2^-48 * (mant1*mant2),
  464. #          die Klammer ist >=2^46, <=(2^24-1)^2<2^48 .
  465. #          Falls die Klammer >=2^47 ist, um 24 Bit nach rechts schieben und
  466. #            runden: Falls Bit 23 Null, abrunden; falls Bit 23 Eins und
  467. #            Bits 22..0 alle Null, round-to-even; sonst aufrunden.
  468. #          Falls die Klammer <2^47 ist, um 23 Bit nach rechts schieben und
  469. #            runden: Falls Bit 22 Null, abrunden; falls Bit 22 Eins und
  470. #            Bits 21..0 alle Null, round-to-even; sonst aufrunden. Nach
  471. #            Aufrunden: Falls =2^24, um 1 Bit nach rechts schieben. Sonst
  472. #            Exponenten um 1 erniedrigen.
  473.  #ifdef FAST_FLOAT
  474.   local object FF_FF_mal_FF(x1,x2)
  475.     var reg1 object x1;
  476.     var reg2 object x2;
  477.     { float_to_FF(FF_to_float(x1) * FF_to_float(x2), return ,
  478.                   TRUE, TRUE, # Overflow und subnormale Zahl abfangen
  479.                   !(FF_zerop(x1) || FF_zerop(x2)), # ein Ergebnis +/- 0.0
  480.                               # ist genau dann in Wirklichkeit ein Underflow
  481.                   FALSE, FALSE # keine Singularität, kein NaN als Ergebnis möglich
  482.                  );
  483.     }
  484.  #else
  485.   local object FF_FF_mal_FF(x1,x2)
  486.     var reg7 object x1;
  487.     var reg8 object x2;
  488.     { # x1,x2 entpacken:
  489.       var reg6 signean sign1;
  490.       var reg3 sintWL exp1;
  491.       var reg4 uintL mant1;
  492.       var reg10 signean sign2;
  493.       var reg9 sintWL exp2;
  494.       var reg5 uintL mant2;
  495.       FF_decode(x1, { return x1; }, sign1=,exp1=,mant1=);
  496.       FF_decode(x2, { return x2; }, sign2=,exp2=,mant2=);
  497.       exp1 = exp1 + exp2; # Summe der Exponenten
  498.       sign1 = sign1 ^ sign2; # Ergebnis-Vorzeichen
  499.      {var reg1 uintL manthi;
  500.       var reg2 uintL mantlo;
  501.       # Mantissen mant1 und mant2 multiplizieren:
  502.       mulu24(mant1,mant2, manthi=,mantlo=);
  503.       manthi = (manthi << (32-FF_mant_len)) | (mantlo >> FF_mant_len);
  504.       mantlo = mantlo & (bit(FF_mant_len)-1);
  505.       # Nun ist 2^FF_mant_len * manthi + mantlo = mant1 * mant2.
  506.       if (manthi >= bit(FF_mant_len+1))
  507.         # mant1*mant2 >= 2^(2*FF_mant_len+1)
  508.         { if ( ((manthi & bit(0)) ==0) # Bit FF_mant_len =0 -> abrunden
  509.                || ( (mantlo ==0) # Bit FF_mant_len =1 und Bits FF_mant_len-1..0 >0 -> aufrunden
  510.                     # round-to-even, je nach Bit FF_mant_len+1 :
  511.                     && ((manthi & bit(1)) ==0)
  512.              )    )
  513.             # abrunden
  514.             { manthi = manthi >> 1; goto ab; }
  515.             else
  516.             # aufrunden
  517.             { manthi = manthi >> 1; goto auf; }
  518.         }
  519.         else
  520.         # mant1*mant2 < 2^(2*FF_mant_len+1)
  521.         { exp1 = exp1-1; # Exponenten decrementieren
  522.           if ( ((mantlo & bit(FF_mant_len-1)) ==0) # Bit FF_mant_len-1 =0 -> abrunden
  523.                || ( ((mantlo & (bit(FF_mant_len-1)-1)) ==0) # Bit FF_mant_len-1 =1 und Bits FF_mant_len-2..0 >0 -> aufrunden
  524.                     # round-to-even, je nach Bit FF_mant_len :
  525.                     && ((manthi & bit(0)) ==0)
  526.              )    )
  527.             # abrunden
  528.             goto ab;
  529.             else
  530.             # aufrunden
  531.             goto auf;
  532.         }
  533.       auf:
  534.       manthi = manthi+1;
  535.       # Hier ist 2^FF_mant_len <= manthi <= 2^(FF_mant_len+1)
  536.       if (manthi >= bit(FF_mant_len+1)) # rounding overflow?
  537.         { manthi = manthi>>1; exp1 = exp1+1; } # Shift nach rechts
  538.       ab:
  539.       # Runden fertig, 2^FF_mant_len <= manthi < 2^(FF_mant_len+1)
  540.       encode_FF(sign1,exp1,manthi, return);
  541.     }}
  542.  #endif
  543.  
  544. # Liefert zu zwei Single-Float x und y : (/ x y), ein FF.
  545. # FF_FF_durch_FF(x,y)
  546. # kann GC auslösen
  547.   local object FF_FF_durch_FF (object x, object y);
  548. # Methode:
  549. # x2 = 0.0 -> Error
  550. # x1 = 0.0 -> Ergebnis 0.0
  551. # Sonst:
  552. # Ergebnis-Vorzeichen = xor der beiden Vorzeichen von x1 und x2
  553. # Ergebnis-Exponent = Differenz der beiden Exponenten von x1 und x2
  554. # Ergebnis-Mantisse = Mantisse mant1 / Mantisse mant2, gerundet.
  555. #   mant1/mant2 > 1/2, mant1/mant2 < 2;
  556. #   nach Rundung mant1/mant2 >=1/2, <=2*mant1<2.
  557. #   Bei mant1/mant2 >=1 brauche 23 Nachkommabits,
  558. #   bei mant1/mant2 <1 brauche 24 Nachkommabits.
  559. #   Fürs Runden: brauche ein Rundungsbit (Rest gibt an, ob exakt).
  560. #   Brauche daher insgesamt 25 Nachkommabits von mant1/mant2.
  561. #   Dividiere daher (als Unsigned Integers) 2^25*(2^24*mant1) durch (2^24*mant2).
  562. #   Falls der Quotient >=2^25 ist, runde die letzten zwei Bits weg und
  563. #     erhöhe den Exponenten um 1.
  564. #   Falls der Quotient <2^25 ist, runde das letzte Bit weg. Bei rounding
  565. #     overflow schiebe um ein weiteres Bit nach rechts, incr. Exponenten.
  566.  #if defined(FAST_FLOAT) && !defined(I80Z86)
  567.   local object FF_FF_durch_FF(x1,x2)
  568.     var reg1 object x1;
  569.     var reg2 object x2;
  570.     { float_to_FF(FF_to_float(x1) / FF_to_float(x2), return ,
  571.                   TRUE, TRUE, # Overflow und subnormale Zahl abfangen
  572.                   !FF_zerop(x1), # ein Ergebnis +/- 0.0
  573.                               # ist genau dann in Wirklichkeit ein Underflow
  574.                   FF_zerop(x2), # Division durch Null abfangen
  575.                   FALSE # kein NaN als Ergebnis möglich
  576.                  );
  577.     }
  578.  #else
  579.   local object FF_FF_durch_FF(x1,x2)
  580.     var reg8 object x1;
  581.     var reg9 object x2;
  582.     { # x1,x2 entpacken:
  583.       var reg7 signean sign1;
  584.       var reg3 sintWL exp1;
  585.       var reg5 uintL mant1;
  586.       var reg10 signean sign2;
  587.       var reg10 sintWL exp2;
  588.       var reg6 uintL mant2;
  589.       FF_decode(x2, { divide_0(); }, sign2=,exp2=,mant2=);
  590.       FF_decode(x1, { return x1; }, sign1=,exp1=,mant1=);
  591.       exp1 = exp1 - exp2; # Differenz der Exponenten
  592.       sign1 = sign1 ^ sign2; # Ergebnis-Vorzeichen
  593.       # Dividiere 2^25*mant1 durch mant2 oder (äquivalent)
  594.       # 2^i*2^25*mant1 durch 2^i*mant2 für irgendein i mit 0 <= i <= 32-24 :
  595.      {var reg1 uintL mant;
  596.       var reg4 uintL rest;
  597.       # wähle i = 32-(FF_mant_len+1), also i+(FF_mant_len+2) = 33.
  598.       divu_6432_3232(mant1<<1,0, mant2<<(32-(FF_mant_len+1)), mant=,rest=);
  599.       if (mant >= bit(FF_mant_len+2))
  600.         # Quotient >=2^25 -> 2 Bits wegrunden
  601.         { var reg2 uintL rounding_bits = mant & (bit(2)-1);
  602.           exp1 += 1; # Exponenten incrementieren
  603.           mant = mant >> 2;
  604.           if ( (rounding_bits < bit(1)) # 00,01 werden abgerundet
  605.                || ( (rounding_bits == bit(1)) # 10
  606.                     && (rest == 0) # und genau halbzahlig
  607.                     && ((mant & bit(0)) ==0) # -> round-to-even
  608.              )    )
  609.             # abrunden
  610.             {}
  611.             else
  612.             # aufrunden
  613.             { mant += 1; }
  614.         }
  615.         else
  616.         # Quotient <2^25 -> 1 Bit wegrunden
  617.         { var reg2 uintL rounding_bit = mant & bit(0);
  618.           mant = mant >> 1;
  619.           if ( (rounding_bit == 0) # 0 wird abgerundet
  620.                || ( (rest == 0) # genau halbzahlig
  621.                     && ((mant & bit(0)) ==0) # -> round-to-even
  622.              )    )
  623.             # abrunden
  624.             {}
  625.             else
  626.             # aufrunden
  627.             { mant += 1;
  628.               if (mant >= bit(FF_mant_len+1)) # rounding overflow?
  629.                 { mant = mant>>1; exp1 = exp1+1; }
  630.         }   }
  631.       encode_FF(sign1,exp1,mant, return);
  632.     }}
  633.  #endif
  634.  
  635. # Liefert zu einem Single-Float x>=0 : (sqrt x), ein FF.
  636. # FF_sqrt_FF(x)
  637. # kann GC auslösen
  638.   local object FF_sqrt_FF (object x);
  639. # Methode:
  640. # x = 0.0 -> Ergebnis 0.0
  641. # Ergebnis-Vorzeichen := positiv,
  642. # Ergebnis-Exponent := ceiling(e/2),
  643. # Ergebnis-Mantisse:
  644. #   Bilde aus [1,m22,...,m0,(26 Nullbits)] bei geradem e,
  645. #         aus [0,1,m22,...,m0,(25 Nullbits)] bei ungeradem e
  646. #   die Ganzzahl-Wurzel, eine 25-Bit-Zahl mit einer führenden 1.
  647. #   Runde das letzte Bit weg:
  648. #     Bit 0 = 0 -> abrunden,
  649. #     Bit 0 = 1 und Wurzel exakt -> round-to-even,
  650. #     Bit 0 = 1 und Rest >0 -> aufrunden.
  651. #   Dabei um ein Bit nach rechts schieben.
  652. #   Bei Aufrundung auf 2^24 (rounding overflow) Mantisse um 1 Bit nach rechts
  653. #     schieben und Exponent incrementieren.
  654.   local object FF_sqrt_FF(x)
  655.     var reg3 object x;
  656.     { # x entpacken:
  657.       var reg2 sintWL exp;
  658.       var reg1 uint32 mant;
  659.       FF_decode(x, { return x; },_EMA_,exp=,mant=);
  660.       # Um die 64-Bit-Ganzzahl-Wurzel ausnutzen zu können, fügen wir beim
  661.       # Radikanden 39 bzw. 40 statt 25 bzw. 26 Nullbits an.
  662.       if (exp & bit(0))
  663.         # e ungerade
  664.         { mant = mant << (31-(FF_mant_len+1)); exp = exp+1; }
  665.         else
  666.         # e gerade
  667.         { mant = mant << (32-(FF_mant_len+1)); }
  668.       exp = exp >> 1; # exp := exp/2
  669.      {var reg4 boolean exactp;
  670.       isqrt_64_32(mant,0, mant=,exactp=); # mant := isqrt(mant*2^32), eine 32-Bit-Zahl
  671.       # Die hinteren 31-FF_mant_len Bits wegrunden:
  672.       if ( ((mant & bit(30-FF_mant_len)) ==0) # Bit 7 =0 -> abrunden
  673.            || ( ((mant & (bit(30-FF_mant_len)-1)) ==0) # Bit 7 =1 und Bits 6..0 >0 -> aufrunden
  674.                 && exactp                   # Bit 7 =1 und Bits 6..0 =0, aber Rest -> aufrunden
  675.                 # round-to-even, je nach Bit 8 :
  676.                 && ((mant & bit(31-FF_mant_len)) ==0)
  677.          )    )
  678.         # abrunden
  679.         { mant = mant >> (31-FF_mant_len); }
  680.         else
  681.         # aufrunden
  682.         { mant = mant >> (31-FF_mant_len);
  683.           mant += 1;
  684.           if (mant >= bit(FF_mant_len+1)) # rounding overflow?
  685.             { mant = mant>>1; exp = exp+1; }
  686.         }
  687.       encode_FF(0,exp,mant, return);
  688.     }}
  689.  
  690. # FF_to_I(x) wandelt ein Single-Float x, das eine ganze Zahl darstellt,
  691. # in ein Integer um.
  692. # kann GC auslösen
  693.   local object FF_to_I (object x);
  694. # Methode:
  695. # Falls x=0.0, Ergebnis 0.
  696. # Sonst (ASH Vorzeichen*Mantisse (e-24)).
  697.   local object FF_to_I(x)
  698.     var reg4 object x;
  699.     { # x entpacken:
  700.       var reg3 signean sign;
  701.       var reg2 sintWL exp;
  702.       var reg1 uint32 mant;
  703.       FF_decode(x, { return Fixnum_0; }, sign=,exp=,mant=);
  704.       exp = exp-(FF_mant_len+1);
  705.       return I_I_ash_I(
  706.         # mant >0, <2^(FF_mant_len+1) in ein Fixnum umwandeln:
  707.         #if (FF_mant_len+1 <= oint_data_len)
  708.           (sign==0 ? posfixnum(mant) : negfixnum(-(oint)mant))
  709.         #else
  710.           L_to_I(sign==0 ? mant : -mant)
  711.         #endif
  712.         ,L_to_FN(exp)
  713.         );
  714.     }
  715.  
  716. # I_to_FF(x) wandelt ein Integer x in ein Single-Float um und rundet dabei.
  717. # kann GC auslösen
  718.   local object I_to_FF (object x);
  719. # Methode:
  720. # x=0 -> Ergebnis 0.0
  721. # Merke Vorzeichen von x.
  722. # x:=(abs x)
  723. # Exponent:=(integer-length x)
  724. #   Greife die 25 höchstwertigen Bits heraus (angeführt von einer 1).
  725. #   Runde das letzte Bit weg:
  726. #     Bit 0 = 0 -> abrunden,
  727. #     Bit 0 = 1 und Rest =0 -> round-to-even,
  728. #     Bit 0 = 1 und Rest >0 -> aufrunden.
  729. #   Dabei um ein Bit nach rechts schieben.
  730. #   Bei Aufrundung auf 2^24 (rounding overflow) Mantisse um 1 Bit nach rechts
  731. #     schieben und Exponent incrementieren.
  732.   local object I_to_FF(x)
  733.     var reg7 object x;
  734.     { if (eq(x,Fixnum_0)) { return FF_0; }
  735.      {var reg8 signean sign = R_sign(x); # Vorzeichen
  736.       if (!(sign==0)) { x = I_minus_I(x); } # bei x<0: x := (- x)
  737.       {   var reg9 uintL exp = I_integer_length(x); # (integer-length x)
  738.           # NDS zu x>0 bilden:
  739.        {  var reg2 uintD* MSDptr;
  740.           var reg5 uintC len;
  741.           I_to_NDS_nocopy(x, MSDptr=,len=,_EMA_);
  742.           # MSDptr/len/LSDptr ist die NDS zu x, len>0.
  743.           # Führende Digits holen: Brauche FF_mant_len+1 Bits, dazu intDsize
  744.           # Bits (die NDS kann mit bis zu intDsize Nullbits anfangen).
  745.           # Dann werden diese Bits um (exp mod intDsize) nach rechts geschoben.
  746.         { var reg4 uintD msd = *MSDptr++; # erstes Digit
  747.           var reg1 uint32 msdd = 0; # weitere min(len-1,32/intDsize) Digits
  748.           #define NEXT_DIGIT(i)  \
  749.             { if (--len == 0) goto ok;                            \
  750.               msdd |= (uint32)(*MSDptr++) << (32-(i+1)*intDsize); \
  751.             }
  752.           DOCONSTTIMES(32/intDsize,NEXT_DIGIT);
  753.           #undef NEXT_DIGIT
  754.           --len; ok:
  755.           # Die NDS besteht aus msd, msdd, und len weiteren Digits.
  756.           # Das höchste in 2^32*msd+msdd gesetzte Bit ist Bit Nummer
  757.           # 31 + (exp mod intDsize).
  758.          {var reg6 uintL shiftcount = exp % intDsize;
  759.           var reg3 uint32 mant = # führende 32 Bits
  760.             (shiftcount==0
  761.              ? msdd
  762.              : (((uint32)msd << (32-shiftcount)) | (msdd >> shiftcount))
  763.             );
  764.           # Das höchste in mant gesetzte Bit ist Bit Nummer 31.
  765.           if ( ((mant & bit(30-FF_mant_len)) ==0) # Bit 7 =0 -> abrunden
  766.                || ( ((mant & (bit(30-FF_mant_len)-1)) ==0) # Bit 7 =1 und Bits 6..0 =0
  767.                     && ((msdd & (bit(shiftcount)-1)) ==0) # und weitere Bits aus msdd =0
  768.                     && (!test_loop_up(MSDptr,len)) # und alle weiteren Digits =0
  769.                     # round-to-even, je nach Bit 8 :
  770.                     && ((mant & bit(31-FF_mant_len)) ==0)
  771.              )    )
  772.             # abrunden
  773.             { mant = mant >> (31-FF_mant_len); }
  774.             else
  775.             # aufrunden
  776.             { mant = mant >> (31-FF_mant_len);
  777.               mant += 1;
  778.               if (mant >= bit(FF_mant_len+1)) # rounding overflow?
  779.                 { mant = mant>>1; exp = exp+1; }
  780.             }
  781.           encode_FF(sign,(sintL)exp,mant, return);
  782.     }}}}}}
  783.  
  784. # RA_to_FF(x) wandelt eine rationale Zahl x in ein Single-Float um
  785. # und rundet dabei.
  786. # kann GC auslösen
  787.   local object RA_to_FF (object x);
  788. # Methode:
  789. # x ganz -> klar.
  790. # x = +/- a/b mit Integers a,b>0:
  791. #   Seien n,m so gewählt, daß
  792. #     2^(n-1) <= a < 2^n, 2^(m-1) <= b < 2^m.
  793. #   Dann ist 2^(n-m-1) < a/b < 2^(n-m+1).
  794. #   Berechne n=(integer-length a) und m=(integer-length b) und
  795. #   floor(2^(-n+m+25)*a/b) :
  796. #   Bei n-m>=25 dividiere a durch (ash b (n-m-25)),
  797. #   bei n-m<25 dividiere (ash a (-n+m+25)) durch b.
  798. #   Der erste Wert ist >=2^24, <2^26.
  799. #   Falls er >=2^25 ist, runde 2 Bits weg,
  800. #   falls er <2^25 ist, runde 1 Bit weg.
  801.   local object RA_to_FF(x)
  802.     var reg3 object x;
  803.     { if (RA_integerp(x)) { return I_to_FF(x); }
  804.       # x Ratio
  805.       pushSTACK(TheRatio(x)->rt_den); # b
  806.       x = TheRatio(x)->rt_num; # +/- a
  807.      {var reg7 signean sign = R_sign(x); # Vorzeichen
  808.       if (!(sign==0)) { x = I_minus_I(x); } # Betrag nehmen, liefert a
  809.       pushSTACK(x);
  810.       # Stackaufbau: b, a.
  811.       {var reg4 sintL lendiff = I_integer_length(x) # (integer-length a)
  812.                                 - I_integer_length(STACK_1); # (integer-length b)
  813.        if (lendiff > FF_exp_high-FF_exp_mid) # Exponent >= n-m > Obergrenze ?
  814.          { fehler_overflow(); } # -> Overflow
  815.        if (lendiff < FF_exp_low-FF_exp_mid-2) # Exponent <= n-m+2 < Untergrenze ?
  816.          { if (underflow_allowed())
  817.              { fehler_underflow(); } # -> Underflow
  818.              else
  819.              { skipSTACK(2); return FF_0; }
  820.          }
  821.        { var reg5 object zaehler;
  822.          var reg6 object nenner;
  823.          if (lendiff >= FF_mant_len+2)
  824.            # n-m-25>=0
  825.            { nenner = I_I_ash_I(STACK_1,fixnum((uint32)(lendiff - (FF_mant_len+2)))); # (ash b n-m-25)
  826.              zaehler = popSTACK(); # a
  827.              skipSTACK(1);
  828.            }
  829.            else
  830.            { zaehler = I_I_ash_I(popSTACK(),fixnum((uint32)((FF_mant_len+2) - lendiff))); # (ash a -n+m+25)
  831.              nenner = popSTACK(); # b
  832.            }
  833.          # Division zaehler/nenner durchführen:
  834.          I_I_divide_I_I(zaehler,nenner);
  835.          # Stackaufbau: q, r.
  836.          # 2^24 <= q < 2^26, also ist q Fixnum oder Bignum mit bn_minlength Digits.
  837.         {var reg1 uint32 mant = ((FF_mant_len+3 <= oint_data_len)
  838.                                  ? posfixnum_to_L(STACK_1)
  839.                                  : I_to_UL(STACK_1)
  840.                                 );
  841.          if (mant >= bit(FF_mant_len+2))
  842.            # 2^25 <= q < 2^26, schiebe um 2 Bits nach rechts
  843.            { var reg2 uintL rounding_bits = mant & (bit(2)-1);
  844.              lendiff = lendiff+1; # Exponent := n-m+1
  845.              mant = mant >> 2;
  846.              if ( (rounding_bits < bit(1)) # 00,01 werden abgerundet
  847.                   || ( (rounding_bits == bit(1)) # 10
  848.                        && (eq(STACK_0,Fixnum_0)) # und genau halbzahlig (r=0)
  849.                        && ((mant & bit(0)) ==0) # -> round-to-even
  850.                 )    )
  851.                # abrunden
  852.                goto ab;
  853.                else
  854.                # aufrunden
  855.                goto auf;
  856.            }
  857.            else
  858.            { var reg2 uintL rounding_bit = mant & bit(0);
  859.              mant = mant >> 1;
  860.              if ( (rounding_bit == 0) # 0 wird abgerundet
  861.                   || ( (eq(STACK_0,Fixnum_0)) # genau halbzahlig (r=0)
  862.                        && ((mant & bit(0)) ==0) # -> round-to-even
  863.                 )    )
  864.                # abrunden
  865.                goto ab;
  866.                else
  867.                # aufrunden
  868.                goto auf;
  869.            }
  870.          auf:
  871.          mant += 1;
  872.          if (mant >= bit(FF_mant_len+1)) # rounding overflow?
  873.            { mant = mant>>1; lendiff = lendiff+1; }
  874.          ab:
  875.          skipSTACK(2);
  876.          # Fertig.
  877.          encode_FF(sign,lendiff,mant, return);
  878.     }}}}}
  879.  
  880.