Return to ieeereal.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / coder

Annotation of researchv10no/cmd/sml/src/coder/ieeereal.sml, revision 1.1.1.1

1.1       root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
                      2: (* ieeereal.sml
                      3:  *
                      4:  * J.H. Reppy
                      5:  * Cornell University
                      6:  * Ithaca, NY  14853
                      7:  * [email protected]
                      8:  *
                      9:  * HISTORY:
                     10:  *   03/15/89  created
                     11:  *   11/20/89  changed argument sig of IEEEReal
                     12:  *
                     13:  * Support for IEEE floating-point constants (for M68881 and SPARC FPU).
                     14:  *
                     15:  * Double precision format (for normalized numbers):
                     16:  *   Bias = 1023.
                     17:  *   Exponent = 11 bits.
                     18:  *   Range of exponent = [1..2046]
                     19:  *   Mantissa = 52 (+1) bits.
                     20:  *   Value = (-1)^s * 2^(e-1023) * 1.f
                     21:  *
                     22:  * Sub-normal numbers (biased exponent = 0)
                     23:  *   Bias = 1022
                     24:  *   Mantissa = 52 bits.
                     25:  *   Value = (-1)^s * 2^-1022 * 0.f
                     26:  *)
                     27: 
                     28: functor IEEEReal (val emitWord : int -> unit) : PRIMREAL =
                     29: struct
                     30: 
                     31:     val significant = 53 (* 52 + redundant 1 bit *)
                     32: 
                     33:     fun outofrange s = ErrorMsg.complain("Real constant "^s^" out of range")
                     34: 
                     35:   (* Convert a portion of a boolean array to the appropriate integer. *)
                     36:     exception Bits
                     37:     fun bits(a, start, width) = let
                     38:          fun b true = 1
                     39:            | b false = 0
                     40:          fun f 0 = b (a sub start)
                     41:            | f n = b (a sub (start+n)) + 2 * f(n-1)
                     42:          in
                     43:            if (Array.length a < start+width) orelse (start < 0) orelse (width < 0)
                     44:              then raise Bits
                     45:              else f (width-1)
                     46:          end
                     47: 
                     48:   (* Emit a real constant with the given sign, the mantissa frac and with the
                     49:    * unbiased exponent exp.
                     50:    *)
                     51:     fun emitreal (sign, frac, exp) = let
                     52:          val exponent = exp + 1022
                     53:          fun emit () = let
                     54:                val word0 = case frac sub 0 (* zero? *)
                     55:                       of true => Bits.orb(Bits.lshift(sign,15),
                     56:                            Bits.orb(Bits.lshift(exponent,4), bits(frac,1,4)))
                     57:                        | false => 0
                     58:                val word1 = bits(frac,5,16)
                     59:                val word2 = bits(frac,21,16)
                     60:                val word3 = bits(frac,37,16)
                     61:                in
                     62:                  emitWord word0;
                     63:                  emitWord word1;
                     64:                  emitWord word2;
                     65:                  emitWord word3
                     66:                end
                     67:          in
                     68:            if exponent < 1
                     69:              then outofrange "" (** A sub-normal number **)
                     70:              else if exponent > 2047
                     71:                then outofrange "" (* A hack *)
                     72:                else emit()
                     73:          end
                     74: 
                     75: end (* functor IEEEReal *)

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.