home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / src / flo_konv.d < prev    next >
Encoding:
Text File  |  1996-04-15  |  23.6 KB  |  627 lines
  1. # Konversionen zwischen Floating-Points
  2.  
  3. # Konversionen ohne Rundung:
  4.  
  5. # SF_to_FF(x) wandelt ein Short-Float x in ein Single-Float um.
  6. # kann GC auslösen
  7.   local object SF_to_FF (object x);
  8.   local object SF_to_FF(x)
  9.     var reg1 object x;
  10.     { # Falls
  11.       # 1. Keine Konversion im Exponenten nötig,
  12.       # 2. Vorzeichen/Exponent/Mantisse ist im SF (wie im FF) dicht gepackt,
  13.       # 3. der Shift, der die Mantissen erweitert, schiebt das Vorzeichen nach
  14.       #    Bit 31,
  15.       # kann einfach geshiftet werden.
  16.       #if (SF_exp_len==FF_exp_len) && (SF_exp_low>=FF_exp_low) && (SF_exp_mid==FF_exp_mid) && (SF_exp_high<=FF_exp_high) && (vorz_bit_o==SF_exp_len+SF_exp_shift)
  17.         # Dadurch auch 31-vorz_bit_o = 31-SF_exp_len-SF_exp_shift
  18.         #                            = 31-FF_exp_len-SF_mant_len-SF_mant_shift
  19.         #                            = FF_mant_len-SF_mant_len-SF_mant_shift
  20.         { return
  21.             allocate_ffloat(
  22.               ((uint32)(as_oint(x) >> SF_mant_shift) << (FF_mant_len-SF_mant_len))
  23.                            );
  24.         }
  25.       #else
  26.         # x entpacken:
  27.         var reg4 signean sign;
  28.         var reg3 sintWL exp;
  29.         var reg2 uint32 mant;
  30.         SF_decode(x, { return FF_0; }, sign=,exp=,mant=);
  31.         # Mantisse um 23-16=7 Bits nach links schieben:
  32.         encode_FF(sign,exp,mant<<(FF_mant_len-SF_mant_len), return);
  33.       #endif
  34.     }
  35.  
  36. # SF_to_DF(x) wandelt ein Short-Float x in ein Double-Float um.
  37. # kann GC auslösen
  38.   local object SF_to_DF (object x);
  39.   local object SF_to_DF(x)
  40.     var reg1 object x;
  41.     { # x entpacken:
  42.       var reg4 signean sign;
  43.       var reg3 sintWL exp;
  44.       var reg2 uint32 mant;
  45.       SF_decode(x, { return DF_0; }, sign=,exp=,mant=);
  46.       # Mantisse um 52-16=36 Nullbits erweitern:
  47.       #ifdef intQsize
  48.       encode_DF(sign,exp,(uint64)mant<<(DF_mant_len-SF_mant_len), return);
  49.       #else
  50.       encode2_DF(sign,exp,mant<<(DF_mant_len-SF_mant_len-32),0, return);
  51.       #endif
  52.     }
  53.  
  54. # SF_to_LF(x,len) wandelt ein Short-Float x in ein Long-Float mit len Digits um.
  55. # > uintC len: gewünschte Anzahl Digits, >=LF_minlen
  56. # kann GC auslösen
  57.   local object SF_to_LF (object x, uintC len);
  58.   local object SF_to_LF(x,len)
  59.     var reg1 object x;
  60.     var reg2 uintC len;
  61.     { # x entpacken:
  62.       var reg5 signean sign;
  63.       var reg4 sintL exp;
  64.       var reg3 uint32 mant;
  65.       SF_decode(x, { encode_LF0(len, return); }, sign=,exp=(sintL),mant=);
  66.       # Long-Float allozieren,
  67.       # Mantisse mit intDsize*len-SF_mant_len-1 Nullbits auffüllen:
  68.      {var reg6 object y = allocate_lfloat(len,exp+LF_exp_mid,sign);
  69.       var reg1 uintD* ptr = &TheLfloat(y)->data[0];
  70.       # erste k := ceiling(SF_mant_len+1,intDsize) Digits mit mant füllen:
  71.       mant = mant << (ceiling(SF_mant_len+1,intDsize)*intDsize-(SF_mant_len+1));
  72.       set_max32_Dptr(SF_mant_len+1,ptr,mant);
  73.       clear_loop_up(&ptr[ceiling(SF_mant_len+1,intDsize)],len-ceiling(SF_mant_len+1,intDsize));
  74.       return y;
  75.     }}
  76.  
  77. # FF_to_DF(x) wandelt ein Single-Float x in ein Double-Float um.
  78. # kann GC auslösen
  79.   local object FF_to_DF (object x);
  80.   local object FF_to_DF(x)
  81.     var reg1 object x;
  82.     { # x entpacken:
  83.       var reg4 signean sign;
  84.       var reg3 sintWL exp;
  85.       var reg2 uint32 mant;
  86.       FF_decode(x, { return DF_0; }, sign=,exp=,mant=);
  87.       # Mantisse um 52-23=29 Nullbits erweitern:
  88.       #ifdef intQsize
  89.       encode_DF(sign,exp,(uint64)mant<<(DF_mant_len-FF_mant_len), return);
  90.       #else
  91.       encode2_DF(sign,exp,mant>>(32-(DF_mant_len-FF_mant_len)),mant<<(DF_mant_len-FF_mant_len), return);
  92.       #endif
  93.     }
  94.  
  95. # FF_to_LF(x,len) wandelt ein Single-Float x in ein Long-Float mit len Digits um.
  96. # > uintC len: gewünschte Anzahl Digits, >=LF_minlen
  97. # kann GC auslösen
  98.   local object FF_to_LF (object x, uintC len);
  99.   local object FF_to_LF(x,len)
  100.     var reg1 object x;
  101.     var reg2 uintC len;
  102.     { # x entpacken:
  103.       var reg5 signean sign;
  104.       var reg4 sintL exp;
  105.       var reg3 uint32 mant;
  106.       FF_decode(x, { encode_LF0(len, return); }, sign=,exp=(sintL),mant=);
  107.       # Long-Float allozieren,
  108.       # Mantisse mit intDsize*len-FF_mant_len-1 Nullbits auffüllen:
  109.      {var reg6 object y = allocate_lfloat(len,exp+LF_exp_mid,sign);
  110.       var reg1 uintD* ptr = &TheLfloat(y)->data[0];
  111.       # erste k := ceiling(FF_mant_len+1,intDsize) Digits mit mant füllen:
  112.       mant = mant << (ceiling(FF_mant_len+1,intDsize)*intDsize-(FF_mant_len+1));
  113.       set_max32_Dptr(FF_mant_len+1,ptr,mant);
  114.       clear_loop_up(&ptr[ceiling(FF_mant_len+1,intDsize)],len-ceiling(FF_mant_len+1,intDsize));
  115.       return y;
  116.     }}
  117.  
  118. # DF_to_LF(x,len) wandelt ein Double-Float x in ein Long-Float mit len Digits um.
  119. # > uintC len: gewünschte Anzahl Digits, >=LF_minlen
  120. # kann GC auslösen
  121.   local object DF_to_LF (object x, uintC len);
  122.   local object DF_to_LF(x,len)
  123.     var reg1 object x;
  124.     var reg2 uintC len;
  125.     { # x entpacken:
  126.       var reg5 signean sign;
  127.       var reg4 sintL exp;
  128.       var reg3 uint32 manthi;
  129.       var reg3 uint32 mantlo;
  130.       #ifdef intQsize
  131.       var reg3 uint64 mant;
  132.       DF_decode(x, { encode_LF0(len, return); }, sign=,exp=(sintL),mant=);
  133.       #else
  134.       DF_decode2(x, { encode_LF0(len, return); }, sign=,exp=(sintL),manthi=,mantlo=);
  135.       #endif
  136.       # Long-Float allozieren,
  137.       # Mantisse mit intDsize*len-DF_mant_len-1 Nullbits auffüllen:
  138.      {var reg6 object y = allocate_lfloat(len,exp+LF_exp_mid,sign);
  139.       var reg1 uintD* ptr = &TheLfloat(y)->data[0];
  140.       # erste k := ceiling(DF_mant_len+1,intDsize) Digits mit mant füllen:
  141.       #define shiftcount  (ceiling(DF_mant_len+1,intDsize)*intDsize-(DF_mant_len+1))
  142.       #ifdef intQsize
  143.       mant = mant<<shiftcount;
  144.       manthi = (uint32)(mant>>32); mantlo = (uint32)mant;
  145.       #else
  146.       manthi = (manthi<<shiftcount) | (mantlo>>(32-shiftcount));
  147.       mantlo = mantlo<<shiftcount;
  148.       #endif
  149.       #undef shiftcount
  150.       set_max32_Dptr(DF_mant_len+1-32,ptr,manthi);
  151.       set_32_Dptr(&ptr[ceiling(DF_mant_len+1-32,intDsize)],mantlo);
  152.       clear_loop_up(&ptr[ceiling(DF_mant_len+1,intDsize)],len-ceiling(DF_mant_len+1,intDsize));
  153.       return y;
  154.     }}
  155.  
  156. # Konversionen mit Rundung:
  157.  
  158. # FF_to_SF(x) wandelt ein Single-Float x in ein Short-Float um.
  159.   local object FF_to_SF (object x);
  160.   local object FF_to_SF(x)
  161.     var reg1 object x;
  162.     { # x entpacken:
  163.       var reg4 signean sign;
  164.       var reg3 sintWL exp;
  165.       var reg2 uint32 mant;
  166.       FF_decode(x, { return SF_0; }, sign=,exp=,mant=);
  167.       # 23-16 Bits wegrunden:
  168.       #define shiftcount  (FF_mant_len-SF_mant_len)
  169.       if ( ((mant & bit(shiftcount-1)) ==0) # Bit 6 war 0 -> abrunden
  170.            || ( ((mant & (bit(shiftcount-1)-1)) ==0) # war 1, Bits 5..0 >0 -> aufrunden
  171.                 # round-to-even
  172.                 && ((mant & bit(shiftcount)) ==0)
  173.          )    )
  174.         # abrunden
  175.         { mant = mant >> shiftcount; }
  176.         else
  177.         # aufrunden
  178.         { mant = mant >> shiftcount;
  179.           mant = mant+1;
  180.           if (mant >= bit(SF_mant_len+1))
  181.             # Überlauf durchs Runden
  182.             { mant = mant>>1; exp = exp+1; } # Mantisse rechts schieben
  183.         }
  184.       #undef shiftcount
  185.       encode_SF(sign,exp,mant, return);
  186.     }
  187.  
  188. # DF_to_SF(x) wandelt ein Double-Float x in ein Short-Float um.
  189.   local object DF_to_SF (object x);
  190.   local object DF_to_SF(x)
  191.     var reg1 object x;
  192.     { # x entpacken:
  193.       var reg4 signean sign;
  194.       var reg3 sintWL exp;
  195.       #ifdef intQsize
  196.       var reg2 uint64 mant;
  197.       DF_decode(x, { return SF_0; }, sign=,exp=,mant=);
  198.       # 52-16=36 Bits wegrunden:
  199.       #define shiftcount  (DF_mant_len-SF_mant_len)
  200.       if ( ((mant & bit(shiftcount-1)) ==0) # Bit 35 war 0 -> abrunden
  201.            || ( ((mant & (bit(shiftcount-1)-1)) ==0) # war 1, Bits 34..0 >0 -> aufrunden
  202.                 # round-to-even
  203.                 && ((mant & bit(shiftcount)) ==0)
  204.          )    )
  205.         # abrunden
  206.         { mant = mant >> shiftcount; }
  207.         else
  208.         # aufrunden
  209.         { mant = mant >> shiftcount;
  210.           mant = mant+1;
  211.           if (mant >= bit(SF_mant_len+1))
  212.             # Überlauf durchs Runden
  213.             { mant = mant>>1; exp = exp+1; } # Mantisse rechts schieben
  214.         }
  215.       #undef shiftcount
  216.       encode_SF(sign,exp,mant, return);
  217.       #else
  218.       var reg2 uint32 manthi;
  219.       var reg2 uint32 mantlo;
  220.       DF_decode2(x, { return SF_0; }, sign=,exp=,manthi=,mantlo=);
  221.       # 52-16=36 Bits wegrunden:
  222.       #define shiftcount  (DF_mant_len-SF_mant_len-32)
  223.       if ( ((manthi & bit(shiftcount-1)) ==0) # Bit 35 war 0 -> abrunden
  224.            || ( ((manthi & (bit(shiftcount-1)-1)) ==0) # war 1, Bits 34..0 >0 -> aufrunden
  225.                 && (mantlo==0)
  226.                 # round-to-even
  227.                 && ((manthi & bit(shiftcount)) ==0)
  228.          )    )
  229.         # abrunden
  230.         { manthi = manthi >> shiftcount; }
  231.         else
  232.         # aufrunden
  233.         { manthi = manthi >> shiftcount;
  234.           manthi = manthi+1;
  235.           if (manthi >= bit(SF_mant_len+1))
  236.             # Überlauf durchs Runden
  237.             { manthi = manthi>>1; exp = exp+1; } # Mantisse rechts schieben
  238.         }
  239.       #undef shiftcount
  240.       encode_SF(sign,exp,manthi, return);
  241.       #endif
  242.     }
  243.  
  244. # LF_to_SF(x) wandelt ein Long-Float x in ein Short-Float um.
  245.   local object LF_to_SF (object x);
  246.   local object LF_to_SF(x)
  247.     var reg2 object x;
  248.     { # x entpacken:
  249.       var reg6 signean sign;
  250.       var reg5 sintL exp;
  251.       var reg1 uintD* ptr;
  252.       var reg4 uintC len;
  253.       var reg3 uint32 mant;
  254.       LF_decode(x, { return SF_0; }, sign=,exp=,ptr=,len=,_EMA_);
  255.       # intDsize*len-SF_mant_len-1 Bits der Mantisse wegrunden:
  256.       # erste k := ceiling(SF_mant_len+2,intDsize) Digits nach mant holen:
  257.       mant = get_max32_Dptr(SF_mant_len+2,ptr);
  258.       ptr += ceiling(SF_mant_len+2,intDsize);
  259.       #define shiftcount  (ceiling(SF_mant_len+2,intDsize)*intDsize-(SF_mant_len+1))
  260.       if ( ((mant & bit(shiftcount-1)) ==0) # Bit 14 war 0 -> abrunden
  261.            || ( ((mant & (bit(shiftcount-1)-1)) ==0) # war 1, Bits 13..0 >0 -> aufrunden
  262.                 && !test_loop_up(ptr,len-ceiling(SF_mant_len+2,intDsize)) # weitere Bits /=0 -> aufrunden
  263.                 # round-to-even
  264.                 && ((mant & bit(shiftcount)) ==0)
  265.          )    )
  266.         # abrunden
  267.         { mant = mant >> shiftcount; }
  268.         else
  269.         # aufrunden
  270.         { mant = mant >> shiftcount;
  271.           mant = mant+1;
  272.           if (mant >= bit(SF_mant_len+1))
  273.             # Überlauf durchs Runden
  274.             { mant = mant>>1; exp = exp+1; } # Mantisse rechts schieben
  275.         }
  276.       #undef shiftcount
  277.       encode_SF(sign,exp,mant, return);
  278.     }
  279.  
  280. # DF_to_FF(x) wandelt ein Double-Float x in ein Single-Float um.
  281. # kann GC auslösen
  282.   local object DF_to_FF (object x);
  283.   local object DF_to_FF(x)
  284.     var reg1 object x;
  285.     { # x entpacken:
  286.       var reg4 signean sign;
  287.       var reg3 sintWL exp;
  288.       #ifdef intQsize
  289.       var reg2 uint64 mant;
  290.       DF_decode(x, { return FF_0; }, sign=,exp=,mant=);
  291.       # 52-23=29 Bits wegrunden:
  292.       #define shiftcount  (DF_mant_len-FF_mant_len)
  293.       if ( ((mant & bit(shiftcount-1)) ==0) # Bit 28 war 0 -> abrunden
  294.            || ( ((mant & (bit(shiftcount-1)-1)) ==0) # war 1, Bits 27..0 >0 -> aufrunden
  295.                 # round-to-even
  296.                 && ((mant & bit(shiftcount)) ==0)
  297.          )    )
  298.         # abrunden
  299.         { mant = mant >> shiftcount; }
  300.         else
  301.         # aufrunden
  302.         { mant = mant >> shiftcount;
  303.           mant = mant+1;
  304.           if (mant >= bit(FF_mant_len+1))
  305.             # Überlauf durchs Runden
  306.             { mant = mant>>1; exp = exp+1; } # Mantisse rechts schieben
  307.         }
  308.       #undef shiftcount
  309.       encode_FF(sign,exp,mant, return);
  310.       #else
  311.       var reg2 uint32 manthi;
  312.       var reg2 uint32 mantlo;
  313.       DF_decode2(x, { return FF_0; }, sign=,exp=,manthi=,mantlo=);
  314.       # 52-23=29 Bits wegrunden:
  315.       #define shiftcount  (DF_mant_len-FF_mant_len)
  316.       manthi = (manthi << (32-shiftcount)) | (mantlo >> shiftcount);
  317.       if ( ((mantlo & bit(shiftcount-1)) ==0) # Bit 28 war 0 -> abrunden
  318.            || ( ((mantlo & (bit(shiftcount-1)-1)) ==0) # war 1, Bits 27..0 >0 -> aufrunden
  319.                 # round-to-even
  320.                 && ((mantlo & bit(shiftcount)) ==0)
  321.          )    )
  322.         # abrunden
  323.         {}
  324.         else
  325.         # aufrunden
  326.         { manthi = manthi+1;
  327.           if (manthi >= bit(FF_mant_len+1))
  328.             # Überlauf durchs Runden
  329.             { manthi = manthi>>1; exp = exp+1; } # Mantisse rechts schieben
  330.         }
  331.       #undef shiftcount
  332.       encode_FF(sign,exp,manthi, return);
  333.       #endif
  334.     }
  335.  
  336. # LF_to_FF(x) wandelt ein Long-Float x in ein Single-Float um.
  337. # kann GC auslösen
  338.   local object LF_to_FF (object x);
  339.   local object LF_to_FF(x)
  340.     var reg2 object x;
  341.     { # x entpacken:
  342.       var reg6 signean sign;
  343.       var reg5 sintL exp;
  344.       var reg1 uintD* ptr;
  345.       var reg4 uintC len;
  346.       var reg3 uint32 mant;
  347.       LF_decode(x, { return FF_0; }, sign=,exp=,ptr=,len=,_EMA_);
  348.       # intDsize*len-FF_mant_len-1 Bits der Mantisse wegrunden:
  349.       # erste k := ceiling(FF_mant_len+2,intDsize) Digits nach mant holen:
  350.       mant = get_max32_Dptr(FF_mant_len+2,ptr);
  351.       ptr += ceiling(FF_mant_len+2,intDsize);
  352.       #define shiftcount  (ceiling(FF_mant_len+2,intDsize)*intDsize-(FF_mant_len+1))
  353.       if ( ((mant & bit(shiftcount-1)) ==0) # Bit 7 war 0 -> abrunden
  354.            || ( ((mant & (bit(shiftcount-1)-1)) ==0) # war 1, Bits 6..0 >0 -> aufrunden
  355.                 && !test_loop_up(ptr,len-ceiling(FF_mant_len+2,intDsize)) # weitere Bits /=0 -> aufrunden
  356.                 # round-to-even
  357.                 && ((mant & bit(shiftcount)) ==0)
  358.          )    )
  359.         # abrunden
  360.         { mant = mant >> shiftcount; }
  361.         else
  362.         # aufrunden
  363.         { mant = mant >> shiftcount;
  364.           mant = mant+1;
  365.           if (mant >= bit(FF_mant_len+1))
  366.             # Überlauf durchs Runden
  367.             { mant = mant>>1; exp = exp+1; } # Mantisse rechts schieben
  368.         }
  369.       #undef shiftcount
  370.       encode_FF(sign,exp,mant, return);
  371.     }
  372.  
  373. # LF_to_DF(x) wandelt ein Long-Float x in ein Double-Float um.
  374. # kann GC auslösen
  375.   local object LF_to_DF (object x);
  376.   local object LF_to_DF(x)
  377.     var reg2 object x;
  378.     { # x entpacken:
  379.       var reg6 signean sign;
  380.       var reg5 sintL exp;
  381.       var reg1 uintD* ptr;
  382.       var reg4 uintC len;
  383.       var reg3 uint32 manthi;
  384.       var reg3 uint32 mantlo;
  385.       LF_decode(x, { return DF_0; }, sign=,exp=,ptr=,len=,_EMA_);
  386.       # intDsize*len-DF_mant_len-1 Bits der Mantisse wegrunden:
  387.       # erste k := ceiling(DF_mant_len+2,intDsize) Digits nach manthi,mantlo holen:
  388.       manthi = get_max32_Dptr(DF_mant_len+2-32,ptr);
  389.       mantlo = get_32_Dptr(&ptr[ceiling(DF_mant_len+2-32,intDsize)]);
  390.       ptr += ceiling(DF_mant_len+2,intDsize);
  391.       #define shiftcount  (ceiling(DF_mant_len+2,intDsize)*intDsize-(DF_mant_len+1))
  392.       #ifdef intQsize
  393.       {var reg3 uint64 mant = ((uint64)manthi << 32) | (uint64)mantlo;
  394.        if ( ((mant & bit(shiftcount-1)) ==0) # Bit 10 war 0 -> abrunden
  395.             || ( ((mant & (bit(shiftcount-1)-1)) ==0) # war 1, Bits 9..0 >0 -> aufrunden
  396.                  && !test_loop_up(ptr,len-ceiling(DF_mant_len+2,intDsize)) # weitere Bits /=0 -> aufrunden
  397.                  # round-to-even
  398.                  && ((mant & bit(shiftcount)) ==0)
  399.           )    )
  400.          # abrunden
  401.          { mant = mant >> shiftcount; }
  402.          else
  403.          # aufrunden
  404.          { mant = mant >> shiftcount;
  405.            mant = mant+1;
  406.            if (mant >= bit(DF_mant_len+1))
  407.              # Überlauf durchs Runden
  408.              { mant = mant>>1; exp = exp+1; } # Mantisse rechts schieben
  409.          }
  410.        encode_DF(sign,exp,mant, return);
  411.       }
  412.       #else
  413.       if ( ((mantlo & bit(shiftcount-1)) ==0) # Bit 10 war 0 -> abrunden
  414.            || ( ((mantlo & (bit(shiftcount-1)-1)) ==0) # war 1, Bits 9..0 >0 -> aufrunden
  415.                 && !test_loop_up(ptr,len-ceiling(DF_mant_len+2,intDsize)) # weitere Bits /=0 -> aufrunden
  416.                 # round-to-even
  417.                 && ((mantlo & bit(shiftcount)) ==0)
  418.          )    )
  419.         # abrunden
  420.         { mantlo = (manthi << (32-shiftcount)) | (mantlo >> shiftcount);
  421.           manthi = manthi >> shiftcount;
  422.         }
  423.         else
  424.         # aufrunden
  425.         { mantlo = (manthi << (32-shiftcount)) | (mantlo >> shiftcount);
  426.           manthi = manthi >> shiftcount;
  427.           mantlo = mantlo+1;
  428.           if (mantlo==0)
  429.             { manthi = manthi+1;
  430.               if (manthi >= bit(DF_mant_len+1-32))
  431.                 # Überlauf durchs Runden
  432.                 { manthi = manthi>>1; exp = exp+1; } # Mantisse rechts schieben
  433.         }   }
  434.       encode2_DF(sign,exp,manthi,mantlo, return);
  435.       #endif
  436.       #undef shiftcount
  437.     }
  438.  
  439. #ifdef HAVE_FFI
  440.  
  441. # Konversionen zu IEEE-Floats.
  442.  
  443. # Fehlermeldung wegen NaN
  444. # fehler_nan();
  445.   nonreturning_function(local, fehler_nan, (void));
  446.   local void fehler_nan()
  447.     { 
  448.       //: DEUTSCH "Floating-Point NaN aufgetreten"
  449.       //: ENGLISH "floating point NaN occurred"
  450.       //: FRANCAIS "apparition d'un NaN au lieu d'un nombre à virgule flottante"
  451.       fehler(arithmetic_error, GETTEXT("floating point NaN occurred"));
  452.     }
  453.  
  454. # IEEE-Single-Float:
  455. # Bit 31 = s, Bits 30..23 = e, Bits 22..0 = m.
  456. #   e=0, m=0: vorzeichenbehaftete 0.0
  457. #   e=0, m/=0: subnormale Zahl,
  458. #     Wert = (-1)^s * 2^(1-126) * [ 0 . 0 m22 ... m0 ]
  459. #   1 <= e <= 254 : normalisierte Zahl,
  460. #     Wert = (-1)^s * 2^(e-126) * [ 0 . 1 m22 ... m0 ]
  461. #   e=255, m=0: vorzeichenbehaftete Infinity
  462. #   e=255, m/=0: NaN
  463.  
  464. # c_float_to_FF(&val) wandelt ein IEEE-Single-Float val in ein Single-Float um.
  465. # kann GC auslösen
  466.   global object c_float_to_FF (ffloatjanus* val_);
  467.   global object c_float_to_FF(val_)
  468.     var reg3 ffloatjanus* val_;
  469.     { var reg1 ffloat val = val_->explicit_;
  470.       var reg2 uintBWL exp = (val >> FF_mant_len) & (bit(FF_exp_len)-1); # e
  471.       if (exp == 0) # e=0 ?
  472.         # vorzeichenbehaftete 0.0 oder subnormale Zahl
  473.         { if (!((val << 1) == 0) && underflow_allowed())
  474.             { fehler_underflow(); }
  475.             else
  476.             { return FF_0; } # +/- 0.0 -> 0.0
  477.         }
  478.       elif (exp == 255) # e=255 ?
  479.         { if (!((val << (32-FF_mant_len)) == 0))
  480.             { fehler_nan(); } # NaN
  481.             else
  482.             { fehler_overflow(); } # Infinity, Overflow
  483.         }
  484.       else
  485.         { # Der Exponent muß um FF_exp_mid-126 erhöht werden.
  486.           if ((FF_exp_mid>126) && (exp > FF_exp_high-FF_exp_mid+126))
  487.             { fehler_overflow(); } # Overflow
  488.           val += (FF_exp_mid - 126) << FF_mant_len;
  489.           return allocate_ffloat(val);
  490.     }   }
  491.  
  492. # FF_to_c_float(obj,&val);
  493. # wandelt ein Single-Float obj in ein IEEE-Single-Float val um.
  494.   global void FF_to_c_float (object obj, ffloatjanus* val_);
  495.   global void FF_to_c_float(obj,val_)
  496.     var reg3 object obj;
  497.     var reg4 ffloatjanus* val_;
  498.     { var reg1 ffloat val = ffloat_value(obj);
  499.       # Der Exponent muß um FF_exp_mid-126 erniedrigt werden.
  500.       if (FF_exp_mid>126)
  501.         { var reg2 uintBWL exp = (val >> FF_mant_len) & (bit(FF_exp_len)-1); # e
  502.           if (exp < FF_exp_mid-126+1)
  503.             { if (!(exp == 0))
  504.                 { # produziere denormalisiertes Float
  505.                   val = (val & minus_bit(FF_exp_len+FF_mant_len)) # selbes Vorzeichen
  506.                         | (0 << FF_mant_len) # Exponent 0
  507.                         | (((val & (bit(FF_mant_len)-1)) | bit(FF_mant_len)) # Mantisse shiften
  508.                            >> (FF_exp_mid-126+1 - exp) # shiften
  509.                           );
  510.             }   }
  511.             else
  512.             { val -= (FF_exp_mid - 126) << FF_mant_len; }
  513.         }
  514.       val_->explicit_ = val;
  515.     }
  516.  
  517. # IEEE-Double-Float:
  518. # Bit 63 = s, Bits 62..52 = e, Bits 51..0 = m.
  519. #   e=0, m=0: vorzeichenbehaftete 0.0
  520. #   e=0, m/=0: subnormale Zahl,
  521. #     Wert = (-1)^s * 2^(1-1022) * [ 0 . 0 m51 ... m0 ]
  522. #   1 <= e <= 2046 : normalisierte Zahl,
  523. #     Wert = (-1)^s * 2^(e-1022) * [ 0 . 1 m51 ... m0 ]
  524. #   e=2047, m=0: vorzeichenbehaftete Infinity
  525. #   e=2047, m/=0: NaN
  526.  
  527. # c_double_to_DF(&val) wandelt ein IEEE-Double-Float val in ein Double-Float um.
  528. # kann GC auslösen
  529.   global object c_double_to_DF (dfloatjanus* val_);
  530.   global object c_double_to_DF(val_)
  531.     var reg3 dfloatjanus* val_;
  532.     { var reg1 dfloat val; val = val_->explicit_;
  533.      {
  534.       #ifdef intQsize
  535.       var reg2 uintWL exp = (val >> DF_mant_len) & (bit(DF_exp_len)-1); # e
  536.       if (exp == 0) # e=0 ?
  537.         # vorzeichenbehaftete 0.0 oder subnormale Zahl
  538.         { if (!((val << 1) == 0) && underflow_allowed())
  539.             { fehler_underflow(); }
  540.             else
  541.             { return DF_0; } # +/- 0.0 -> 0.0
  542.         }
  543.       elif (exp == 2047) # e=2047 ?
  544.         { if (!((val << (64-DF_mant_len)) == 0))
  545.             { fehler_nan(); } # NaN
  546.             else
  547.             { fehler_overflow(); } # Infinity, Overflow
  548.         }
  549.       else
  550.         { # Der Exponent muß um DF_exp_mid-1022 erhöht werden.
  551.           if ((DF_exp_mid>1022) && (exp > DF_exp_high-DF_exp_mid+1022))
  552.             { fehler_overflow(); } # Overflow
  553.           val += (sint64)(DF_exp_mid - 1022) << DF_mant_len;
  554.           return allocate_dfloat(val);
  555.         }
  556.       #else
  557.       var reg2 uintWL exp = (val.semhi >> (DF_mant_len-32)) & (bit(DF_exp_len)-1); # e
  558.       if (exp == 0) # e=0 ?
  559.         # vorzeichenbehaftete 0.0 oder subnormale Zahl
  560.         { if (!(((val.semhi << 1) == 0) && (val.mlo == 0)) && underflow_allowed())
  561.             { fehler_underflow(); }
  562.             else
  563.             { return DF_0; } # +/- 0.0 -> 0.0
  564.         }
  565.       elif (exp == 2047) # e=2047 ?
  566.         { if (!(((val.semhi << (64-DF_mant_len)) == 0) && (val.mlo == 0)))
  567.             { fehler_nan(); } # NaN
  568.             else
  569.             { fehler_overflow(); } # Infinity, Overflow
  570.         }
  571.       else
  572.         { # Der Exponent muß um DF_exp_mid-1022 erhöht werden.
  573.           if ((DF_exp_mid>1022) && (exp > DF_exp_high-DF_exp_mid+1022))
  574.             { fehler_overflow(); } # Overflow
  575.           val.semhi += (sint32)(DF_exp_mid - 1022) << (DF_mant_len-32);
  576.           return allocate_dfloat(val.semhi,val.mlo);
  577.         }
  578.       #endif
  579.     }}
  580.  
  581. # DF_to_c_double(obj,&val);
  582. # wandelt ein Double-Float obj in ein IEEE-Double-Float val um.
  583.   global void DF_to_c_double (object obj, dfloatjanus* val_);
  584.   global void DF_to_c_double(obj,val_)
  585.     var reg4 object obj;
  586.     var reg5 dfloatjanus* val_;
  587.     { var reg1 dfloat val; val = TheDfloat(obj)->float_value;
  588.       # Der Exponent muß um DF_exp_mid-1022 erniedrigt werden.
  589.       if (DF_exp_mid>1022)
  590.         #ifdef intQsize
  591.         { var reg2 uintWL exp = (val >> DF_mant_len) & (bit(DF_exp_len)-1); # e
  592.           if (exp < DF_exp_mid-1022+1)
  593.             { if (!(exp == 0))
  594.                 { # produziere denormalisiertes Float
  595.                   val = (val & -bit(DF_exp_len+DF_mant_len)) # selbes Vorzeichen
  596.                         | ((sint64)0 << DF_mant_len) # Exponent 0
  597.                         | (((val & (bit(DF_mant_len)-1)) | bit(DF_mant_len)) # Mantisse shiften
  598.                            >> (DF_exp_mid-1022+1 - exp) # shiften
  599.                           );
  600.             }   }
  601.             else
  602.             { val -= (sint64)(DF_exp_mid - 1022) << DF_mant_len; }
  603.         }
  604.         #else
  605.         { var reg3 uintWL exp = (val.semhi >> (DF_mant_len-32)) & (bit(DF_exp_len)-1); # e
  606.           if (exp < DF_exp_mid-1022+1)
  607.             { if (!(exp == 0))
  608.                 { # produziere denormalisiertes Float
  609.                   var reg2 uintWL shiftcount = DF_exp_mid-1022+1 - exp;
  610.                   val.mlo = val.mlo >> shiftcount; # Mantisse shiften
  611.                   val.mlo |= val.semhi << (32-shiftcount);
  612.                   val.semhi = (val.semhi & minus_bit(DF_exp_len+DF_mant_len-32)) # selbes Vorzeichen
  613.                               | ((sint32)0 << (DF_mant_len-32)) # Exponent 0
  614.                               | (((val.semhi & (bit(DF_mant_len-32)-1)) | bit(DF_mant_len-32)) # Mantisse shiften
  615.                                  >> shiftcount # shiften
  616.                                 );
  617.             }   }
  618.             else
  619.             { val.semhi -= (sint32)(DF_exp_mid - 1022) << (DF_mant_len-32); }
  620.         }
  621.         #endif
  622.       val_->explicit_ = val;
  623.     }
  624.  
  625. #endif
  626.  
  627.