home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / LIBRARY / FLTD.SA < prev    next >
Text File  |  1995-02-05  |  23KB  |  739 lines
  1. -- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
  2. -- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
  3. -- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
  4. -- the file "Doc/License" of the Sather distribution.  The license is also   --
  5. -- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
  6. --------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
  7.  
  8. value class FLTD < $IS_EQ{FLTD}, $IS_LT{FLTD}, $NIL{FLTD} is
  9.    -- IEEE 754-1984 "double" format 64-bit floating point.
  10.    
  11.    create(f:FLT):SAME is
  12.        -- For convenience in creating.  Allows writing #FLTD(45.678).
  13.       return f.fltd
  14.    end;
  15.    
  16.    create(f:SAME):SAME is 
  17.        -- For convenience in creating.  Allows writing #FLTD(45.678d).
  18.        return f;
  19.    end;
  20.  
  21.    plus(f:SAME):SAME is -- The sum of self and `f'. Built-in.
  22.       raise "FLTD::plus(SAME):SAME undefined.";
  23.    end;
  24.  
  25.    minus(f:SAME):SAME is -- The difference between self and `f'. Built-in.     
  26.       raise "FLTD::minus(SAME):SAME undefined.";
  27.    end;   
  28.    
  29.    negate:SAME is
  30.       -- The negation of self. Same as zero minus self.  (Well, almost,
  31.       -- except for IEEE rounding modes and the sign bit.)
  32.       raise "FLTD::negate:SAME undefined.";
  33.    end;
  34.  
  35.    times(f:SAME):SAME is -- The signed product of self and `f'. Built-in.
  36.       raise "FLTD::times(SAME):SAME undefined.";
  37.    end;   
  38.    
  39.    div(f:SAME):SAME is -- The quotient of self and `f'. Built-in.
  40.       raise "FLTD::div(SAME):SAME undefined.";
  41.    end;   
  42.    
  43.    is_eq(f:SAME):BOOL is -- True if self and `f' represent the same value.  Built-in.
  44.       raise "FLTD::is_eq(f:SAME):BOOL undefined.";
  45.    end;
  46.  
  47.    is_neq(f:SAME):BOOL is
  48.       -- True if self and `f' represent different values.  Built-in.
  49.       -- The treatment of NaNs is ambiguous.  IEEE Standard 754 asks
  50.       -- that `eq', `lt', `leq', `gt', and `geq' return _false_ if
  51.       -- either or both operands are NaNs.  The `neq' function is
  52.       -- supposed to be the inverse of `eq', so that _true_ is returned
  53.       -- if one or both of the arguments is a NaN.  Since the standard
  54.       -- behavior would seem to be inconsistent with our other
  55.       -- comparison functions, we punt and do whatever C does with '!='.
  56.  
  57.       raise "FLTD::is_neq(f:SAME):BOOL undefined.";
  58.    end;
  59.    
  60.    is_lt(f:SAME):BOOL is -- True if self is less than `f'. Built-in.
  61.       raise "FLTD::is_lt(SAME):BOOL undefined.";
  62.    end;   
  63.  
  64.    is_leq(f:SAME):BOOL is -- True if self is less than or equal to `f'.  Built-in.
  65.       raise "FLTD::is_leq(SAME):BOOL undefined.";
  66.    end;   
  67.    
  68.    is_gt(f:SAME):BOOL is -- True if self is greater than `f' as signed integers. Built-in.
  69.       raise "FLTD::is_gt(SAME):BOOL undefined.";
  70.    end;   
  71.  
  72.    is_geq(f:SAME):BOOL is -- True if self is greater than or equal to `f'.  Built-in.
  73.       raise "FLTD::is_geq(SAME):BOOL undefined.";
  74.    end;   
  75.  
  76.    is_within(tolerance,val:SAME):BOOL is
  77.        return (self-val).abs<=tolerance;
  78.    end;
  79.  
  80.    -- IEEE functions.
  81.  
  82.    is_finite:BOOL is -- returns true if zero, subnormal or normal.
  83.        return C_FLTD::finite(self);
  84.    end;
  85.  
  86.    is_inf:BOOL is -- returns true if infinite
  87.        return C_FLTD::isinf(self);
  88.    end;
  89.  
  90.    is_nan:BOOL is -- returns true if NaN
  91.        return C_FLTD::isnan(self);
  92.    end;
  93.  
  94.    is_normal:BOOL is -- returns true if normal
  95.        return C_FLTD::isnormal(self);
  96.    end;
  97.  
  98.    is_subnormal:BOOL is -- returns true if subnormal
  99.        return C_FLTD::issubnormal(self);
  100.    end;
  101.  
  102.    is_zero:BOOL is -- returns true is zero
  103.        return C_FLTD::iszero(self);
  104.    end;
  105.  
  106.    signbit_set:BOOL is -- returns true if sign bit of self is set
  107.        return C_FLTD::signbit(self);
  108.    end;
  109.  
  110.    unbiased_exponent:INT is
  111.        -- return unbiased exponent of self as an INT;
  112.        -- for zero this is INT::maxint.negate, for an
  113.        -- infinite it is INT::maxint.  If subnormal,
  114.        -- normalization occurs first.
  115.        return C_FLTD::ilogb(self);
  116.    end;
  117.  
  118.    copysign(y:SAME):SAME is
  119.        -- return self with the sign bit set to the same as y's sign bit.
  120.        return C_FLTD::copysign(self,y);
  121.    end;
  122.  
  123.    nextup:FLTD is -- return next representable number from self.
  124.        return C_FLTD::nextafter(self,1.fltd);
  125.    end;
  126.  
  127.    nextdown:FLTD is -- return previous representable number from self.
  128.        return C_FLTD::nextafter(self,-1.fltd);
  129.    end;
  130.  
  131.    --  x.remainder(y) and x.mod(y) return a remainder of x with respect
  132.    --  to y; that is, the result r is one of the numbers that differ from
  133.    --  x by an integral multiple of y.  Thus (x-r)/y  is an integral
  134.    --  value, even though it might exceed INT::maxint if it were
  135.    --  explicitly computed as an INT.  Both functions return one  of the
  136.    --  two such r smallest in magnitude.  remainder(x,y) is the operation
  137.    --  specified in ANSI/IEEE Std 754-1985; the result of x.mod(y) may
  138.    --  differ from remainder's result by +-y.  The magnitude of
  139.    --  remainder's result can not exceed half that of y; its sign might
  140.    --  not agree with either x or y.  The magnitude of mod's result is
  141.    --  less than that of y; its sign agrees with that of x.  Neither
  142.    --  function will raise an exception as long as both arguments are
  143.    --  normal or subnormal.  x.remainder(0), x.mod(0), oo.remainder(y),
  144.    --  and oo.mod(y) are invalid operations that produce a NaN.
  145.  
  146.    remainder(y:FLTD):FLTD is
  147.       return C_FLTD::remainder(self,y);
  148.    end;
  149.  
  150.    mod(y:FLTD):FLTD is
  151.       return C_FLTD::fmod(self,y);
  152.    end;
  153.  
  154.    scale_by(n:INT):FLTD is
  155.       -- return x*2.pow(n) computed by exponent manipulation rather
  156.       -- than by actually performing an exponentiation or a multiplication.
  157.       -- 1 <= x.abs.scale_by(-x.unbiased_exponent) < 2 for every x
  158.       -- except 0, infinity, and NaN.
  159.       return C_FLTD::scalbn(self,n);
  160.    end;
  161.  
  162.    -- Bessel functions of the first and second kinds.  y0, y1 and yn have
  163.    -- logarithmic singularities at the origin, so they treat zero and
  164.    -- negative arguments the way log does.
  165.  
  166.    bessel_j0:SAME is
  167.       return C_FLTD::j0(self); 
  168.    end;
  169.  
  170.    bessel_j1:SAME is
  171.       return C_FLTD::j1(self); 
  172.    end;
  173.  
  174.    bessel_jn(n:INT):SAME is
  175.       return C_FLTD::jn(n,self); 
  176.    end;
  177.  
  178.    bessel_y0:SAME is
  179.       return C_FLTD::y0(self); 
  180.    end;
  181.  
  182.    bessel_y1:SAME is
  183.       return C_FLTD::y0(self); 
  184.    end;
  185.  
  186.    bessel_yn(n:INT):SAME is
  187.       return C_FLTD::yn(n,self); 
  188.    end;
  189.  
  190.    -- Error functions
  191.  
  192.    erf:SAME is
  193.       -- error function x.erf = (1/sqrt(pi))*integrate(0,x,exp(-t^2)dt)
  194.       return C_FLTD::erf(self);
  195.    end;
  196.  
  197.    one_minus_erf:SAME is
  198.       -- 1.0-self.erf, but computed in a way to avoid cancellation for large self.
  199.       return C_FLTD::erfc(self);
  200.    end;
  201.  
  202.    -- Exponential, logarithm, power functions.  All these functions handle
  203.    -- exceptional arguments in the spirit of IEEE 754-1985.  So:
  204.    -- 0.log is -infinity with a division by zero exception
  205.    -- For x<0, including -infinity, x.log is a quiet NaN with an invalid op exception
  206.    -- For x=+infinity or a quiet NaN, x.log is x without exception
  207.    -- For a signaling NaN, x.log is a quiet NaN with an invalid op exception
  208.    -- 1.log is zero without exception
  209.    -- For any other positive x, x.log is a normalized number with an inexact exception
  210.  
  211.    exp:SAME is -- The exponential e^self.
  212.       return(C_FLTD::exp(self));
  213.    end;
  214.    
  215.    exp_minus_one:SAME is -- e^self-1.0, accurate even for tiny self.
  216.       return(C_FLTD::expm1(self));
  217.    end;
  218.  
  219.    exp2:SAME is -- 2^self
  220.       return(C_FLTD::exp2(self));
  221.    end;
  222.  
  223.    exp10:SAME is -- 10^self
  224.       return(C_FLTD::exp10(self));
  225.    end;
  226.    
  227.    log:SAME is -- The natural logarithm of self.
  228.       return(C_FLTD::log(self));
  229.    end;
  230.  
  231.    plus_one_log:SAME is -- (self+1).log, accurate even for tiny self.
  232.       return(C_FLTD::log1p(self));
  233.    end;
  234.  
  235.    log2:SAME is -- The logarithm base two of self.
  236.       return log10/log10_2;
  237.    end;
  238.  
  239.    log10:SAME is -- The logarithm base ten of self.
  240.       return(C_FLTD::log10(self));
  241.    end;
  242.  
  243.    pow(arg:SAME):SAME is
  244.        -- self raised to the arg'th power.  x.pow(0.0)=1.0 for all x.
  245.        return(C_FLTD::pow(self,arg));
  246.    end;
  247.  
  248.    -- Hyperbolic functions.  They handle exceptional arguments in the
  249.    -- spirit of IEEE 754-1985.  So:
  250.    -- sinh and cosh return +-infinity on overflow
  251.    -- acosh returns a NaN if its argument is less than 1.0
  252.    -- atanh returns a NaN if its argument has an absolute value >1.0
  253.  
  254.    sinh:SAME is -- The hyperbolic sine of self.
  255.        return(C_FLTD::sinh(self)); 
  256.    end;
  257.  
  258.    cosh:SAME is -- The hyperbolic cosine of self.
  259.        return(C_FLTD::cosh(self)); 
  260.    end;
  261.  
  262.    tanh:SAME is -- The hyperbolic tangent of self.
  263.        return(C_FLTD::tanh(self)); 
  264.    end;
  265.  
  266.    asinh:SAME is -- The inverse hyperbolic sine of self.
  267.        return(C_FLTD::asinh(self)); 
  268.    end;
  269.  
  270.    acosh:SAME is -- The inverse hyperbolic cosine of self.
  271.        return(C_FLTD::acosh(self)); 
  272.    end;
  273.  
  274.    atanh:SAME is -- The inverse hyperbolic tangent of self.
  275.        return(C_FLTD::atanh(self)); 
  276.    end;
  277.  
  278.    -- Trigonometric functions.  These functions handle exceptional arguments
  279.    -- in the spirit of IEEE 754-1985.  So:
  280.    -- +-infinity.sin, +-infinity.cos, +-infinity.tan return NaN
  281.    -- x.asin and x.acos with x.abs>1 return NaN
  282.    -- sinpi etc. are similar except they compute self.sinpi=(self*pi).sin avoiding
  283.    -- range-reduction issues because their definition permits range reduction
  284.    -- that is fast and exact for all self.  The corresponding inverse functions
  285.    -- compute asinpi(x)
  286.  
  287.    hypot(arg:SAME):SAME is
  288.        -- sqrt(self*self+arg*arg), taking precautions against unwarranted
  289.        -- IEEE exceptions.  +-infinity.hypot(arg) is +infinity for any arg,
  290.        -- even a NaN, and is exceptional only for a signaling NaN.
  291.        return(C_FLTD::hypot(self,arg));
  292.    end;
  293.  
  294.    sin:SAME is 
  295.        return(C_FLTD::sin(self));
  296.    end;
  297.  
  298.    cos:SAME is
  299.        return(C_FLTD::cos(self));
  300.    end;
  301.  
  302.    --sincos:TUP{SAME,SAME} is
  303.        -- Simultaneous computation of self.sin and self.cos.  This is faster
  304.        -- than independently computing them.
  305.    --    return(C_FLTD::c_fltd_sincos(self));
  306.    -- end;
  307.  
  308.    tan:SAME is
  309.        return(C_FLTD::tan(self));
  310.    end;
  311.  
  312.    asin:SAME is -- The arc sine of self in the range [-pi/2, pi/2]
  313.        return(C_FLTD::asin(self));
  314.    end;
  315.  
  316.    acos:SAME is -- The arc sine of self in the range [0.0, pi]
  317.        return(C_FLTD::acos(self));
  318.    end;
  319.  
  320.    atan:SAME is -- The arc tangent of self in the range [-pi/2, pi/2].
  321.        return(C_FLTD::atan(self));
  322.    end;
  323.  
  324.    atan2(f:SAME):SAME is
  325.       -- The arc tangent of self divided by f in the range [-pi, pi].
  326.       -- It chooses the quadrant specified by (self, arg).
  327.       return(C_FLTD::atan2(self,f));
  328.    end;
  329.  
  330.    sinpi:SAME is 
  331.        return(C_FLTD::sinpi(self));
  332.    end;
  333.  
  334.    cospi:SAME is
  335.        return(C_FLTD::cospi(self));
  336.    end;
  337.  
  338.    -- sincospi:TUP{SAME,SAME} is
  339.        -- Simultaneous computation of self.sinpi and self.cospi.  This is faster
  340.        -- than independently computing them.
  341.    --     return(C_FLTD::c_fltd_sincospi(self));
  342.    -- end;
  343.  
  344.    tanpi:SAME is
  345.        return(C_FLTD::tanpi(self));
  346.    end;
  347.  
  348.    asinpi:SAME is
  349.        -- (1/pi) times the arc sine of self.
  350.        -- Result in the range [-1/2, 1/2]
  351.        return(C_FLTD::asinpi(self));
  352.    end;
  353.  
  354.    acospi:SAME is 
  355.        -- (1/pi) times the arc cosine of self.
  356.        -- Result in the range [0, 1]
  357.        return(C_FLTD::acospi(self));
  358.    end;
  359.  
  360.    atanpi:SAME is 
  361.        -- (1/pi) times the arc tangent of self.
  362.        -- Result in the range [-1/2, 1/2]
  363.        return(C_FLTD::atanpi(self));
  364.    end;
  365.  
  366.    atan2pi(f:SAME):SAME is
  367.       -- (1/pi) times the arc tangent of self divided by f.
  368.       -- Result in the range [-1, 1].
  369.       -- It chooses the quadrant specified by (self, arg).
  370.       return(C_FLTD::atan2pi(self,f));
  371.    end;
  372.  
  373.    -- Miscellaneous
  374.  
  375.    abs:SAME is -- The absolute value of self.
  376.       return(C_FLTD::fabs(self));
  377.    end;
  378.    
  379.    signum:SAME is
  380.       if self<0.0d then return -1.0d;
  381.       elsif self>0.0d then return 1.0d;
  382. --    else return self;                                                         -- NLP
  383.       end; return self;                                                         -- NLP
  384. --    end;                                                                      -- NLP
  385.    end;
  386.  
  387.    log_gamma:SAME is
  388.       -- log gamma function.  x.ln_gamma=x.gamma.abs.log
  389.       return(C_FLTD::lgamma(self));
  390.    end;
  391.  
  392.    gamma:SAME is
  393.       -- gamma function.
  394.       if self>0.0d then return log_gamma.exp;
  395.       elsif integral then return 0.0d;  -- ? Is this correct?
  396.       elsif abs.floor.int.is_even then return -log_gamma.exp;
  397. --    else return log_gamma.exp;                                                -- NLP
  398.       end; return log_gamma.exp;                                                -- NLP
  399. --    end;                                                                      -- NLP
  400.    end;
  401.  
  402.    sqrt:SAME is -- The square root of self.
  403.       return(C_FLTD::sqrt(self));
  404.    end;
  405.  
  406.    square:SAME is -- The square of self.
  407.       return self*self;
  408.    end;
  409.  
  410.    cube_root:SAME is -- The square root of self.
  411.       return(C_FLTD::cbrt(self));
  412.    end;
  413.  
  414.    cube:SAME is -- The cube of self.
  415.       return self*self*self;
  416.    end;
  417.  
  418.    max(arg:SAME):SAME is -- The larger of self and arg.
  419.       -- This is incorrect if one argument is a NaN.
  420. --    if self<arg then return arg; else return self; end;                       -- NLP
  421.       if self<arg then return arg; end; return self;                            -- NLP
  422.    end;
  423.  
  424.    min(arg:SAME):SAME is -- The smaller of self and arg.
  425.       -- This is incorrect if one argument is a NaN.
  426. --    if self<arg then return self; else return arg; end;                       -- NLP
  427.       if self<arg then return self; end; return arg;                            -- NLP
  428.    end;
  429.  
  430.    -- Conversions.
  431.    private shared fdbuf: FSTR;    -- Buffer for temporary writing of floats
  432.    
  433.    str:STR is 
  434.       -- A string version of self.  
  435.       if ((void(fdbuf)) or (fdbuf.size < 30)) then fdbuf := #FSTR(30) end;
  436.       fstr ::= str_in(fdbuf);
  437.       return(fstr.str); end;
  438.    
  439.    str(prec:INT):STR is 
  440.       -- A string version of self with "prec" digits of precision.
  441.       des_sz ::= prec+10;
  442.       if ((void(fdbuf)) or (fdbuf.size<des_sz)) then 
  443.      fdbuf:=#FSTR(des_sz) end;
  444.       fstr ::= str_in(fdbuf,prec);
  445.       return(fstr.str);  end;
  446.    
  447.    str_in(arg:FSTR):FSTR is 
  448.       -- Return an FSTR representation of self using the space in 
  449.       -- arg if possible
  450.       store_in: FSTR;
  451.       if (arg.size >= 30) then store_in := arg;
  452.       else store_in := #FSTR(30) end;
  453.       sz ::= C_FLTD::c_fltd_str_in(self, store_in); 
  454.       store_in.loc := sz;
  455.       return(store_in); end;
  456.  
  457.    str_in(arg:FSTR, prec: INT): FSTR is
  458.       -- Return FSTR version of  self with precicsion of "prec" using the
  459.       -- space in arg if possible. 
  460.       store_in: FSTR;
  461.       des_sz ::= prec+10;
  462.       if (arg.size > des_sz) then store_in := arg
  463.       else store_in := #FSTR(des_sz) end;
  464.       sz ::= C_FLTD::c_fltd_str_in_prec(self,store_in,prec);
  465.       store_in.loc := sz;
  466.       return(store_in);  end;
  467.    
  468.    create (s: STR): SAME is
  469.       return C_FLTD::atof(s)
  470.    end;
  471.    
  472.    int:INT post result.fltd=self is
  473.       -- INT version of self.  It is an error if self is not integral.
  474.       -- Use truncate, floor, ceiling, or round to achieve this.
  475.       return C_FLTD::c_fltd_int(self);
  476.    end;
  477.  
  478.    integral:BOOL is
  479.       -- Return true if self is integral.
  480.       return self=truncate;
  481.    end;
  482.  
  483.    flt:FLT is
  484.       -- A floating point version of self. It is an error if the
  485.       -- value cannot be held in a FLT. Built-in.
  486.       raise "FLTD::flt:FLT undefined." end;   
  487.  
  488.    fltx:FLTX is
  489.       -- An extended floating point version of self. It is an
  490.       -- error if the value cannot be held in a FLTX. Built-in.      
  491.       raise "FLTD::fltx:FLTX undefined." end;
  492.    
  493.    fltdx:FLTDX is
  494.       -- An extended floating point version of self.  Built-in.         
  495.       raise "FLTD::fltdx:FLTDX undefined." end;
  496.  
  497.    truncate:SAME is -- The nearest integer toward zero.
  498.       return C_FLTD::aint(self);
  499.    end;
  500.  
  501.    floor:SAME is -- The largest integer not greater than self.
  502.       return C_FLTD::floor(self);
  503.    end;
  504.  
  505.    ceiling:SAME is -- The smallest integer not less than self.
  506.       return C_FLTD::ceil(self);
  507.    end;
  508.  
  509.    round:SAME is -- The closest integer to self.
  510.       return C_FLTD::rint(self);
  511.    end;
  512.  
  513.    -- Special values.
  514.  
  515.    pi:SAME is
  516.       -- An approximation of the mathematical value "pi".  Built-in.
  517.       raise "FLTD::pi:FLTD undefined";
  518.    end;
  519.  
  520.    e:SAME is
  521.       -- An approximation of the base of the natural logarithms "e".  Built-in.
  522.       raise "FLTD::e:FLTD undefined";
  523.    end;
  524.  
  525.    sqrt_2:SAME is
  526.       -- Approximation of 2.sqrt.  Built-in.
  527.       raise "FLTD::sqrt_2:FLTD undefined";
  528.    end;
  529.  
  530.    log_2:SAME is
  531.       -- Approximation of 2.log.  Built-in.
  532.       raise "FLTD::log_2:FLTD undefined";
  533.    end;
  534.  
  535.    log2_e:SAME is
  536.       -- Approximation of e.log2.  Built-in.
  537.       raise "FLTD::log2_e:FLTD undefined";
  538.    end;
  539.  
  540.    log10_e:SAME is
  541.       -- Approximation of e.log10.  Built-in.
  542.       raise "FLTD::log10_e:FLTD undefined";
  543.    end;
  544.  
  545.    const log10_2:SAME:=(2.0d).log10;
  546.       -- Approximation of 2.0.log10.
  547.  
  548.    log_10:SAME is
  549.       -- Approximation of 10.log.  Built-in.
  550.       raise "FLTD::log_10:FLTD undefined";
  551.    end;
  552.  
  553.    half_pi:SAME is
  554.       -- Approximation of pi/2.  Built-in.
  555.       raise "FLTD::half_pi:FLTD undefined";
  556.    end;
  557.  
  558.    quarter_pi:SAME is
  559.       -- Approximation of pi/4.  Built-in.
  560.       raise "FLTD::quarter_pi:FLTD undefined";
  561.    end;
  562.  
  563.    inv_sqrt_2:SAME is
  564.       -- Approximation of 1/(2.sqrt).  Built-in.
  565.       raise "FLTD::inv_sqrt_2:FLTD undefined";
  566.    end;
  567.  
  568.    inv_pi:SAME is
  569.       -- Approximation of 1/pi.  Built-in.
  570.       raise "FLTD::inv_pi:FLTD undefined";
  571.    end;
  572.  
  573.    double_inv_pi:SAME is
  574.       -- Approximation of 2/pi.  Built-in.
  575.       raise "FLTD::double_inv_pi:FLTD undefined";
  576.    end;
  577.  
  578.    double_sqrt_pi:SAME is
  579.       -- Approximation of 2*(pi.sqrt).  Built-in.
  580.       raise "FLTD::double_sqrt_pi:FLTD undefined";
  581.    end;
  582.  
  583.    -- The value to be used to represent no element in sets.
  584.    const nil:SAME:=signaling_NaN(0);
  585.  
  586.    signaling_NaN(sig:INT):SAME is
  587.        -- IEEE signalling NaN.  `sig' is the significand (presently unused).
  588.        return C_FLTD::signaling_nan(sig);
  589.    end;
  590.  
  591.    quiet_NaN(sig:INT):SAME is 
  592.        -- IEEE quiet NaN.  `sig' is the significand (presently unused).
  593.        return C_FLTD::quiet_nan(sig);
  594.    end;
  595.  
  596.    infinity:SAME is -- IEEE Infinity.
  597.       return C_FLTD::infinity;
  598.    end;
  599.    
  600.    const epsilon:SAME:=2.2204460492503131e-16d; -- The minimum x>0.0 such that 1.0+x/=x. 
  601.  
  602.    const digits:INT:=15; -- The number of decimal digits of precision.
  603.  
  604.    -- The number of bits in the significand, including an implied bit.
  605.    const mantissa_bits:INT:=53;
  606.  
  607.    -- The smallest normalized positive number.
  608.    const min_normal:SAME:=2.2250738585072014e-308d;
  609.  
  610.    -- The largest normalized positive number.
  611.    const max_normal:SAME:=1.7976931348623157e308d;
  612.  
  613.    min_subnormal:SAME is -- The smallest subnormal positive number.
  614.       return C_FLTD::min_subnormal;
  615.    end;
  616.  
  617.    max_subnormal:SAME is -- The largest subnormal positive number.
  618.       return C_FLTD::max_subnormal;
  619.    end;
  620.  
  621.    -- The minimum negative integer x such that b^(x-1) is in the range
  622.    -- of normalized floating point numbers.
  623.    const min_exp:INT:=-1021;
  624.  
  625.    -- The minimum x such that 10^x is in the range of normalized
  626.    -- floating point numbers.
  627.    const min_exp10:INT:=-307;
  628.  
  629.    const max_exp:INT:=1024; -- The maximum allowable exponent.
  630.  
  631.    const max_exp10:INT:=308; -- The maximum x such that 10^x is within range.
  632.  
  633.    -- Useful iters
  634.  
  635.    sum!(i:SAME!):SAME is
  636.       -- Yields the sum of all previous values of `i'.
  637.       r::=0.0d; loop r:=r+i; yield r end end;
  638.  
  639.    product!(i:SAME!):SAME is
  640.       -- Yields the product of all previous values of `i'.
  641.       r::=1.0d; loop r:=r*i; yield r end end;
  642.  
  643. end; -- class FLTD
  644.  
  645. -------------------------------------------------------------------
  646. external class C_FLTD is
  647.     -- This corresponds to the standard math functions linkable with "-lm".   
  648.  
  649.     finite(a:FLTD):BOOL;
  650.     isinf(a:FLTD):BOOL;
  651.     isnan(a:FLTD):BOOL;
  652.     iszero(a:FLTD):BOOL;
  653.     isnormal(a:FLTD):BOOL;
  654.     issubnormal(a:FLTD):BOOL;
  655.     signbit(a:FLTD):BOOL;
  656.     ilogb(a:FLTD):INT;
  657.     copysign(a:FLTD,b:FLTD):FLTD;
  658.     nextafter(a:FLTD,b:FLTD):FLTD;
  659.     remainder(a:FLTD,b:FLTD):FLTD;
  660.     fmod(a:FLTD,b:FLTD):FLTD;
  661.     scalbn(a:FLTD,b:INT):FLTD;
  662.     j0(a:FLTD):FLTD;
  663.     j1(a:FLTD):FLTD;
  664.     jn(a:INT,b:FLTD):FLTD;
  665.     y0(a:FLTD):FLTD;
  666.     y1(a:FLTD):FLTD;
  667.     yn(a:INT,b:FLTD):FLTD;
  668.     erf(a:FLTD):FLTD;
  669.     erfc(a:FLTD):FLTD;
  670.     exp(a:FLTD):FLTD;
  671.     expm1(a:FLTD):FLTD;
  672.     exp2(a:FLTD):FLTD;
  673.     exp10(a:FLTD):FLTD;
  674.     log(a:FLTD):FLTD;
  675.     log1p(a:FLTD):FLTD;
  676.     log10(a:FLTD):FLTD;
  677.     pow(a:FLTD,b:FLTD):FLTD;
  678.     sinh(a:FLTD):FLTD;
  679.     cosh(a:FLTD):FLTD;
  680.     tanh(a:FLTD):FLTD;
  681.     asinh(a:FLTD):FLTD;
  682.     acosh(a:FLTD):FLTD;
  683.     atanh(a:FLTD):FLTD;
  684.     hypot(a:FLTD,b:FLTD):FLTD;
  685.     sin(a:FLTD):FLTD;
  686.     cos(a:FLTD):FLTD;
  687.     --c_fltd_sincos(a:FLTD):TUP{FLTD,FLTD};
  688.     tan(a:FLTD):FLTD;
  689.     asin(a:FLTD):FLTD;
  690.     acos(a:FLTD):FLTD;
  691.     atan(a:FLTD):FLTD;
  692.     atan2(a:FLTD,b:FLTD):FLTD;
  693.     sinpi(a:FLTD):FLTD;
  694.     cospi(a:FLTD):FLTD;
  695.     --c_fltd_sincospi(a:FLTD):TUP{FLTD,FLTD};
  696.     tanpi(a:FLTD):FLTD;
  697.     asinpi(a:FLTD):FLTD;
  698.     acospi(a:FLTD):FLTD;
  699.     atanpi(a:FLTD):FLTD;
  700.     atan2pi(a:FLTD,b:FLTD):FLTD;
  701.     fabs(a:FLTD):FLTD;
  702.     lgamma(a:FLTD):FLTD;
  703.     sqrt(a:FLTD):FLTD;
  704.     cbrt(a:FLTD):FLTD;
  705.     aint(a:FLTD):FLTD;
  706.     floor(a:FLTD):FLTD;
  707.     ceil(a:FLTD):FLTD;
  708.     rint(a:FLTD):FLTD;
  709.     signaling_nan(a:INT):FLTD;
  710.     quiet_nan(a:INT):FLTD;
  711.     infinity:FLTD;
  712.     min_subnormal:FLTD;
  713.     max_subnormal:FLTD;
  714.     c_fltd_int(a:FLTD):INT;
  715.     c_fltd_str_in(f: FLTD, store_in: FSTR): INT;
  716.     c_fltd_str_in_prec(f: FLTD, store_in: FSTR, precision: INT): INT;
  717.    atof(s: STR): FLTD;
  718.    
  719. end;
  720. -------------------------------------------------------------------   
  721. class TEST_FLTD is
  722.    include TEST;
  723.    
  724.    main is
  725.       class_name("FLTD");
  726.       test("str 1",(0.1234567d).str,"0.123457"); -- ok? davids or om must
  727.      -- verify that this is the desired behaviour.
  728.       test("str prec=2",(-1234.12345d).str(2),"-1.2e+03");
  729.       test("str prec=3",(-1234.12345d).str(3),"-1.23e+03");
  730.       test("str prec=4",(1234.12345d).str(4),"1234");
  731.       test("str prec=5",(1234.12345d).str(5),"1234.1");
  732.       test("str prec=6",(1234.12345d).str(6),"1234.12");
  733.       finish;
  734.       end;
  735.    
  736. end; -- class TEST_FLTD
  737.  
  738. -------------------------------------------------------------------
  739.