home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / languages / turbo_part1.lha / modula / m2 / RealInOut.mod < prev    next >
Encoding:
Modula Implementation  |  1994-11-13  |  4.5 KB  |  153 lines

  1. (* @B+ Turn array checking ON *)
  2. IMPLEMENTATION MODULE RealInOut ;
  3.  
  4. FROM InOut IMPORT Write, WriteString, ReadString,WriteInt ;
  5.  
  6. PROCEDURE Ten( x : INTEGER ) : REAL ;
  7. (* Returns 10^x as a REAL *)
  8.     VAR res , r : REAL ; neg : BOOLEAN ;
  9. BEGIN
  10.   neg := x < 0 ;
  11.   x := ABS( x ) ;
  12.   res := 1.0 ; r := 10.0 ;
  13.   WHILE x # 0 DO
  14.     IF ODD( x ) THEN res := res * r END ;
  15.     r := r * r ;
  16.     x := x DIV 2
  17.   END ;
  18.   IF neg THEN RETURN 1.0 / res ELSE RETURN res END
  19. END Ten ;
  20.  
  21. PROCEDURE Expo( x : REAL ) : INTEGER ;
  22. (* Returns exponent (base 2) of x. For IEEE single precision reals only *)
  23.   TYPE cardAr = ARRAY [0..1] OF CARDINAL ;
  24.        VAR ca : cardAr ;
  25. BEGIN
  26.   ca := cardAr(x) ;
  27.   RETURN (ca[0]/128)MOD 256 ; (* Strip out & return bits 1..9 in x *)
  28. END Expo ;
  29.  
  30. PROCEDURE StrToReal( str : (*@N*) ARRAY OF CHAR ) : REAL ;
  31.  
  32.   VAR i : LONGINT ;
  33.  
  34.   PROCEDURE Read(VAR ch : CHAR ) ;
  35.   BEGIN INC(i) ; ch := str[i] ;
  36.   END Read ;
  37.  
  38.   VAR
  39.     mantissa , exponent : LONGINT ;
  40.     fraction , negativeExp : BOOLEAN ;
  41.     fractionalDigits , truncatedDigits : LONGINT ;
  42.     neg  : BOOLEAN ;
  43.     ch   : CHAR    ;
  44.     real : REAL ;
  45.  
  46. BEGIN
  47.   fraction := FALSE ; neg := FALSE ;
  48.   mantissa := 0 ; exponent := 0 ;
  49.   fractionalDigits := 0 ; truncatedDigits := 0 ; i := -1 ;
  50.   REPEAT
  51.     Read( ch ) ; (* skip ws *)
  52.   UNTIL (ch # " ") & (ch # "\t") ;
  53.   IF ( ch # "-") & (ch # "+") & ~(("0" <= ch ) & ( ch <= "9" )) THEN
  54.     done := FALSE ; RETURN 0.0
  55.   END ;
  56.   IF ch = "-" THEN neg := TRUE ; Read(ch) ELSIF ch = "+" THEN Read(ch) END ;
  57.   WHILE ( "0" <= ch ) AND ( ch <= "9" ) DO
  58.     IF mantissa <= MAX( LONGINT ) DIV 10 THEN
  59.       mantissa := 10 * mantissa ;
  60.       IF mantissa <= MAX( LONGINT ) - ( ORD( ch ) - ORD ("0") ) THEN
  61.     INC( mantissa , ORD( ch ) - ORD ("0") ) ;
  62.       ELSE INC( truncatedDigits ) ;
  63.       END ;
  64.     ELSE INC( truncatedDigits ) ;
  65.     END ;
  66.     Read(ch);
  67.     IF fraction THEN INC( fractionalDigits ) END ;
  68.     IF ( ch = "." ) & ~fraction THEN
  69.       fraction:= TRUE ; Read(ch) ;
  70.       IF NOT(("0" <= ch ) & ( ch <= "9" )) THEN done := FALSE ; RETURN 0.0 END
  71.     END
  72.   END ;
  73.   IF ch = 'E' THEN Read(ch) ;
  74.     IF    ch = "+" THEN negativeExp := FALSE ; Read(ch)
  75.     ELSIF ch = "-" THEN negativeExp := TRUE  ; Read(ch)
  76.     ELSE negativeExp := FALSE
  77.     END ;
  78.     IF NOT(("0" <= ch ) & ( ch <= "9" )) THEN done := FALSE ; RETURN 0.0 END ;
  79.     WHILE ( "0" <= ch ) AND ( ch <= "9" ) DO
  80.       exponent := 10 * exponent + ORD( ch ) - ORD("0") ;
  81.       Read( ch )
  82.     END ;
  83.     IF negativeExp THEN exponent := -exponent END
  84.   END ;
  85.   DEC( exponent , fractionalDigits - truncatedDigits ) ;
  86.   IF neg THEN real := -( FLOAT( mantissa ) * Ten( exponent ) )
  87.   ELSE real := FLOAT( mantissa ) * Ten( exponent )
  88.   END ;
  89.   done := Expo( real ) # 255 ;
  90.   RETURN real
  91. END StrToReal ;
  92.  
  93. VAR
  94.   buff : ARRAY [0..255] OF CHAR ;
  95.  
  96. PROCEDURE ReadReal( VAR r : REAL ) ;
  97. BEGIN ReadString(buff) ; r := StrToReal(buff)
  98. END ReadReal ;
  99.  
  100. PROCEDURE WriteReal( x : REAL ; n : INTEGER ) ;
  101. (* Modified from Oberon texts module *)
  102.   VAR
  103.     e , i : INTEGER ;
  104.    x0 ,xx : REAL ;
  105.         d : ARRAY [0..9] OF CHAR ;
  106. BEGIN
  107.   e := Expo( x ) ;
  108.   WriteInt(e,10);
  109.   IF e = 0 THEN
  110.     REPEAT Write(" "); DEC(n) UNTIL n <= 3 ;
  111.     WriteString("  0")
  112.   ELSIF e = 255 THEN
  113.     WHILE n > 4 DO Write(" ") ; DEC( n ) END ;
  114.     WriteString(" NaN")
  115.   ELSE
  116.     IF n <= 9 THEN n := 3 ELSE DEC( n, 6 ) END ;
  117.     WHILE n > 7 DO Write(" ") ; DEC( n ) END ;
  118.     (* there are 3 <= n <= 7 digits to be written *)
  119.     xx := x ; x := ABS(x) ;
  120.     e := VAL( LONGINT, e - 127 ) * 77 DIV 256 ;
  121.     IF e >= 0 THEN x := x / Ten(e) ELSE x := Ten(-e) * x END ;
  122.     IF x >= 10.0 THEN x := 0.1 * x ; INC(e) END ;
  123.     x0 := Ten( n-1 ) ; x := x0*x + 0.5 ;
  124.     IF x >= 10.0*x0 THEN x := 0.1 * x ; INC( e ) END ;
  125.     i := 0 ;
  126.     REPEAT
  127.       d[i] := CHR( TRUNC(x) MOD 10 + 30H ) ; x := x / 10.0 ; INC (i)
  128.     UNTIL i = n ;
  129.     IF e >= 0 THEN Write(" ") END ;
  130.     IF xx < 0.0 THEN Write("-") ELSE Write(" ") END ;
  131.     IF ( e > 0 ) & ( e < n ) THEN
  132.       INC( e ) ;
  133.       REPEAT DEC( n ) ; Write( d[n] ) ; DEC( e ) UNTIL e = 0 ;
  134.       IF n = 0 THEN WriteString(".0E0") ; RETURN ELSE Write(".") END ;
  135.       REPEAT DEC( n ) ; Write( d[n] ) UNTIL n = 0
  136.     ELSIF ( e < 0 ) & ( ABS(e) < n ) THEN
  137.       WriteString("0.");
  138.       INC( e ) ;
  139.       WHILE e # 0 DO Write("0") ; DEC( n ) ; INC(e) END ;
  140.       IF n # 0 THEN REPEAT DEC(n) ; Write( d[n] ) UNTIL n = 0 END
  141.     ELSE
  142.       DEC( n ) ; Write(d[n]) ; Write(".") ;
  143.       REPEAT DEC( n ) ; Write( d[n] ) UNTIL n = 0
  144.     END ;
  145.     Write("E") ;
  146.     IF e < 0 THEN Write("-") ; e := -e END ;
  147.     Write( CHR(e DIV 10 + 30H ) ) ;
  148.     Write( CHR(e MOD 10 + 30H ) )
  149.   END
  150. END WriteReal ;
  151.  
  152. END RealInOut.
  153.