home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / languages / obrn-a_1.5_lib.lha / oberon-a / source2.lha / Source / ProjectOberon / Reals.mod < prev    next >
Encoding:
Text File  |  1995-01-26  |  4.6 KB  |  189 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: Reals.mod $
  4.   Description: Low-level floating point conversions
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.6 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/26 00:48:34 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15.   Log entries are at the end of the file.
  16.  
  17. ***************************************************************************)
  18.  
  19. <* MAIN- *> <*$ LongVars+ *>
  20.  
  21. MODULE Reals;
  22.  
  23. (*
  24. ** This module performs low-level operations on REAL and LONGREAL
  25. ** values. The values are assumed to be in IEEE floating-point format.
  26. ** At present both REAL and LONGREAL values are 32-bit single-precision
  27. ** values. In future LONGREAL will be re-implemented as 64-bit
  28. ** double-precision values.
  29. **
  30. ** IEEE single-precision reals have the following format:
  31. **
  32. ** SEEEEEEE EMMMMMMM MMMMMMMM MMMMMMMM
  33. ** 31       23       15       7
  34. **
  35. ** S = sign, E = exponent, M = mantissa
  36. *)
  37.  
  38. IMPORT SYS := SYSTEM;
  39.  
  40. (*------------------------------------*)
  41. PROCEDURE Expo* (x : REAL) : INTEGER;
  42. (*
  43. ** This procedure extracts the exponent part of a REAL value. This is
  44. ** held in bits 23-30.
  45. *)
  46.  
  47. BEGIN (* Expo *)
  48.   RETURN SHORT (SYS.LSH (SYS.VAL (LONGINT, x), -23)) MOD 256
  49. END Expo;
  50.  
  51. (*------------------------------------*)
  52. PROCEDURE ExpoL* (x : LONGREAL) : INTEGER;
  53.  
  54. BEGIN (* ExpoL *)
  55.   RETURN Expo (SHORT (x))
  56. END ExpoL;
  57.  
  58. (*------------------------------------*)
  59. PROCEDURE SetExpo* (e : INTEGER; VAR x : REAL);
  60. (*
  61.  * This procedure sets the exponent part of a REAL variable.  It clears bits
  62.  * 23-30 using SYS.AND() and ORs the exponent onto the cleared area.
  63.  *
  64.  * Broken down into simple expressions, the algorithm is:
  65.  *   i := SYS.VAL (LONGINT, x);
  66.  *   i := SYS.AND (i, 087FFFFFFH);
  67.  *   e := SYS.LSH (e MOD 256, 23);
  68.  *   i := SYS.LOR (i, e);
  69.  *   x := SYS.VAL (REAL, i)
  70.  *)
  71.  
  72. BEGIN (* SetExpo *)
  73.   x :=
  74.     SYS.VAL
  75.       ( REAL,
  76.         SYS.LOR
  77.           ( SYS.AND ( SYS.VAL (LONGINT, x), 087FFFFFFH ),
  78.             SYS.LSH (LONG (e MOD 256), 23) ) )
  79. END SetExpo;
  80.  
  81. (*------------------------------------*)
  82. PROCEDURE SetExpoL* (e : INTEGER; VAR x : LONGREAL);
  83.  
  84.   VAR y : REAL;
  85.  
  86. BEGIN (* SetExpoL *)
  87.   y := SHORT (x); SetExpo (e, y); x := LONG (y)
  88. END SetExpoL;
  89.  
  90. (*------------------------------------*)
  91. PROCEDURE Ten* (e : INTEGER) : REAL;
  92.  
  93.   VAR result : REAL; n : INTEGER;
  94.  
  95. BEGIN (* Ten *)
  96.   result := 1.0; n := ABS (e);
  97.   WHILE n > 0 DO result := result * 10.0; DEC (n) END;
  98.   IF e >= 0 THEN
  99.     RETURN result
  100.   ELSE
  101.     RETURN 1.0 / result
  102.   END;
  103. END Ten;
  104.  
  105. (*------------------------------------*)
  106. PROCEDURE TenL* (e : INTEGER) : LONGREAL;
  107.  
  108. BEGIN (* TenL *)
  109.   RETURN LONG (Ten (e))
  110. END TenL;
  111.  
  112. (*------------------------------------*)
  113. PROCEDURE Convert* (x : REAL; n : INTEGER; VAR d : ARRAY OF CHAR);
  114. (*
  115.  * Converts a REAL into a string.  d will contain the n most significant
  116.  * digits of x, in REVERSE order.
  117.  *)
  118.  
  119.   VAR i : LONGINT;
  120.  
  121. BEGIN (* Convert *)
  122.   i := 0;
  123.   REPEAT
  124.     d [i] := CHR (ENTIER (x) MOD 10 + 30H); x := x / 10; INC (i)
  125.   UNTIL i = n;
  126. END Convert;
  127.  
  128. (*------------------------------------*)
  129. PROCEDURE ConvertL* (x : LONGREAL; n : INTEGER; VAR d : ARRAY OF CHAR);
  130.  
  131. BEGIN (* ConvertL *)
  132.   Convert (SHORT (x), n, d)
  133. END ConvertL;
  134.  
  135. (*------------------------------------*)
  136. PROCEDURE ConvertH* (x : REAL; VAR d : ARRAY OF CHAR);
  137. (*
  138.  * Converts a REAL into a hexadecimal string.
  139.  *)
  140.  
  141.   VAR i, j, k : LONGINT;
  142.  
  143. BEGIN (* ConvertH *)
  144.   d [7] := 0X; (* This should cause an index trap if d is too small. *)
  145.   (* Turn off index checking now, since we know there is enough room. *)
  146.   <*$ < IndexChk- *>
  147.   k := SYS.VAL (LONGINT, x);
  148.   i := 8;
  149.   REPEAT
  150.     DEC (i);
  151.     IF k # 0 THEN
  152.       j := k MOD 10H; k := k DIV 10H;
  153.       IF j < 10 THEN d [i] := CHR (j + 30H) ELSE d [i] := CHR (j + 37H) END
  154.     ELSE
  155.       d [i] := "0"
  156.     END;
  157.   UNTIL i = 0;
  158.   <*$ > *>
  159. END ConvertH;
  160.  
  161. (*------------------------------------*)
  162. PROCEDURE ConvertHL* (x : LONGREAL; VAR d : ARRAY OF CHAR);
  163.  
  164. BEGIN (* ConvertHL *)
  165.   ConvertH (SHORT (x), d)
  166. END ConvertHL;
  167.  
  168. END Reals.
  169.  
  170. (***************************************************************************
  171.  
  172.   $Log: Reals.mod $
  173.   Revision 1.6  1995/01/26  00:48:34  fjc
  174.   - Release 1.5
  175.  
  176.   Revision 1.5  1994/11/11  17:00:38  fjc
  177.   - Uses new external code interface.
  178.  
  179.   Revision 1.5  1994/11/11  17:00:38  fjc
  180.   - Uses new external code interface.
  181.  
  182.   Revision 1.4  1994/09/18  21:25:47  fjc
  183.   - Converted switches to pragmas/options
  184.  
  185.   Revision 1.1  1994/01/15  21:39:12  fjc
  186.   - Start of revision control
  187.  
  188. ***************************************************************************)
  189.