IMPLEMENTATION MODULE DemoRealInOut;
(*
 * G. Maier, Hybridrechenzentrum, ETH Zürich 12-Oct-82
 * J. Lutz, Inst. f. Informationsv. Uni Tübingen 15-Sept-83 (unix)
 *
 * Darstellung der Realzahlen auf PDP-11
 * Bit   Bedeutung
 * 15    Vorzeichen der Mantisse 1 negativ
 * 14-7  8-bit Exponent excess 200octal
 * 6-0   23-bits plus 1 'verstecktes' bit (alle Zahlen normalisiert)
 * 15-0  Mantisse
 *
 * J.P. Kupfer (SIGMA), 8-Nov-88 (ported to Amiga)
 * J.P. Kupfer (SIGMA), 2-Jan-89 (Update)
 * J.P. Kupfer (SIGMA), 3-Jan-89 (1. Prozedur ReadReal ohne LOOP!
 *                                2. Alle 'again...'-Teile entfernt!
 *                                3. Prozedur Readstring entfernt! )
 *
 * Darstellung der Realzahlen auf dem Amiga:
 * nach Motorola, Info c/o Fridtjof Siebert (Amok) besten Dank!
 *
 * Standard-REAL 32 Bit breit:
 * SEEEEEEE EMMMMMMM MMMMMMMM MMMMMMMM
 * S = Vorzeichen, E = Exponent, M = Mantisse
 *
 * Zusatz: Das 1. Bit der Mantisse wird immer als 1 angenommen und
 *         deshalb nicht geschrieben!
 *
 * Berechnung: Zahl = 2^(Exponent-126)*(Mantisse+0.5)
 *
 * Beispiele:
 * 01000000 01000000 00000000 00000000 = 2^(128-126)*(0.5+0.25) = 3
 * 01000000 10010000 00000000 00000000 = 2^(129-126)*(0.5+0.0625) = 4.5
 * 11100101 10101001 01101000 00010111 =
 * = 2^(203-126)*(0.5+0.125+0.03125+0.00390625+....) = -1.000E+23
 *                1/2   1/8  1/32       1/256   ...
 *
 * Bereich: -1.0E38 <= real <= 1.0E38
 *
 *)

IMPORT InOut; (* Write, WriteLn, Read; globaler Import, weil diese
                 Prozeduren hier umdefiniert werden.                     *)

CONST
  EOL = 12C;  (* end of line = linefeed! *)

PROCEDURE Write(ch:CHAR);
  BEGIN
    InOut.Write(ch);
  END Write;

PROCEDURE WriteLn;
  BEGIN
    InOut.WriteLn;
  END WriteLn;

PROCEDURE Writestring(s:ARRAY OF CHAR);
  VAR i:CARDINAL;
  BEGIN
    FOR i:=0 TO HIGH(s) DO
      IF s[i] = 0C THEN RETURN END;
      Write(s[i]);
    END; (* FOR *)
  END Writestring;

PROCEDURE Read(VAR ch:CHAR);
  BEGIN
    InOut.Read(ch);
  END Read;

(* auxiliary procedures *)

PROCEDURE convertnumber(num,base,len:CARDINAL;ch:CHAR;neg:BOOLEAN);
  (* legal values for 'base': 8,10 *)
  (* Die Variable 'base' ist jetzt eigentlich überflüssig,
     aber wenn ich sie heraus nehme, dann muß ich das Modul
     nochmal komplett umstricken!         Jochen 3-1-89            *)
  VAR
    digit :ARRAY[1..9] OF CHAR;
    i,cnt :CARDINAL;
  BEGIN
    cnt := 0;
    IF base=8 THEN INC(cnt); digit[cnt]:='C' END;
    REPEAT
      INC(cnt);
      digit[cnt] := CHAR(num MOD base + CARDINAL('0'));
      num := num DIV base;
    UNTIL num=0;
    IF neg THEN INC(cnt);digit[cnt]:='-' END;
    FOR i:=len TO cnt+1 BY -1 DO Write(ch) END;
    FOR i:=cnt TO 1 BY -1 DO Write(digit[i]) END;
  END convertnumber;

PROCEDURE max(a,b:INTEGER):INTEGER;
  BEGIN
    IF a >= b THEN RETURN a ELSE RETURN b END;
  END max;

PROCEDURE exp10(i:INTEGER):REAL;
  VAR
    x,b :REAL;
    k   :INTEGER;
  BEGIN
    IF i>0 THEN b := 1.0E1 ELSE b := 1.0E-1 END;
    x := 1.0;
    FOR k:=1 TO ABS(i) DO x := x*b END;
    RETURN x;
  END exp10;

PROCEDURE error(s:ARRAY OF CHAR);
  BEGIN
    Writestring("+++++ conversion-error in '");
    Writestring(s);Writestring("'?.");
    WriteLn;
  END error;

PROCEDURE WriteReal(x:REAL;totlen:CARDINAL;fraclen:INTEGER);
  VAR
    exponent                  :INTEGER;
    before,behind,minimal,i,y :CARDINAL;
    deltaround                :REAL;
    sign,exponential          :BOOLEAN;
    ch                        :CHAR;
  BEGIN  (* WriteReal *)
    (* Vorzeichen *)
    IF x<0.0 THEN sign := TRUE; x := ABS(x) ELSE sign := FALSE END;
    (* exponential representation? *)
    IF (fraclen<0) OR (x>=1.0E8) THEN
       exponential := TRUE;
       fraclen     := ABS(fraclen); minimal := 7; (* characters *)
    ELSE
       exponential := FALSE;
       minimal     := 3; (* characters *)
    END; (* IF *)
    (* how many characters before and behind the decimal-point? *)
    totlen := max(totlen,minimal);
    behind := -max(-fraclen,INTEGER(minimal)-INTEGER(totlen));
    before := totlen - behind - minimal + 2;
    deltaround := 0.5*exp10(-INTEGER(behind));
    IF exponential THEN (* normalize *)
       exponent := 0;
       WHILE (x<1.0-deltaround) AND (x#0.0) DO
         x := x*1.0E+1; DEC(exponent);
       END; (* WHILE *)
       WHILE (x>=10.0-deltaround) DO
         x := x*1.0E-1; INC(exponent);
       END; (* WHILE *)
    END; (* IF *)
    x := x + deltaround; (* round *)

    (* write digits before decimal-point *)
    ch := ' ';
    IF (x>=1.0E4) THEN   (* Wieso gerade 4? -------- ------- ---- *)
       y := TRUNC(x*1.0E-4);
       convertnumber(y,10,max(before-4,1),ch,sign); sign := FALSE;
       before := 4; x := x - FLOAT(y)*1.0E4; ch := '0';
    END; (* IF *)
    y := TRUNC(x);
    convertnumber(y,10,before,ch,sign);
    x := x - FLOAT(y);

    Write(".");

    (* write digits behind decimal-point *)
    WHILE behind>0 DO
      i := -max(-INTEGER(behind),-4);
      x := x*exp10(i); y := TRUNC(x);
      convertnumber(y,10,i,'0',FALSE);
      x := x - FLOAT(y); behind := behind - i;
    END; (* WHILE *)

    IF exponential THEN (* write exponent *)
       Write("E");
       IF exponent>=0 THEN Write("+") ELSE Write("-") END;
       convertnumber(ABS(exponent),10,2,'0',FALSE);
    END; (* IF *)
  END WriteReal;

PROCEDURE ReadExponent(VAR x:INTEGER);
  VAR
    ch               :CHAR;
    sign,value       :INTEGER;
    cnt,i            :CARDINAL;
  CONST
    maxStellen = 3;
    maxExp     = 38; (* Für Standard-REAL *)
    null       = INTEGER('0');
  BEGIN (* ReadExponent *)
    Read(ch);
    sign := 1;
    IF (ch='+') OR (ch='-') THEN
       sign := -1*ORD(ch='-')+ORD(ch='+');
       Read(ch);
    END;
    value := 0; cnt := 0;
    WHILE (ch>='0') AND (ch<='9') AND (cnt<maxStellen) DO
      value := value*10 + (INTEGER(ch)-null);
      Read(ch);
      cnt := cnt + 1;
    END; (* WHILE *)
    IF value > maxExp THEN
       error("ReadExponent");
       done := FALSE;
    END;
    value := sign*value;
    x := value;
  END ReadExponent;

PROCEDURE ReadReal(VAR x:REAL); (* read a real number *)
  VAR
    w,dummy  :REAL;   (* Hilfsvariable dummy, für den Fall, daß nichts *)
    exponent :INTEGER;              (* sinnvolles gelesen wurde!!!     *)
    ch       :CHAR;
    sign     :BOOLEAN;
  BEGIN (* ReadReal *)
    dummy := x;    (* Zur späteren Verwendung! *)
      done := TRUE;
      sign := FALSE;
      REPEAT Read(ch) UNTIL ch#' '; (* skip blanks *)
      IF (ch='+') OR (ch='-') THEN sign := ch='-'; Read(ch) END;
      IF (ch>='0') AND (ch<='9') THEN (* at least one digit *)
        x := 0.0;
        REPEAT
          x := x*10.0 + FLOAT(CARDINAL(ORD(ch))-CARDINAL(ORD('0')));
          Read(ch);
        UNTIL (ch<'0') OR (ch>'9');
        IF ch='.' THEN
          w := 1.0E-1;Read(ch);
          WHILE (ch<='9') AND (ch>='0') DO
            x := x + w*FLOAT(CARDINAL(ORD(ch))-CARDINAL(ORD('0')));
            w := w*1.0E-1;Read(ch);
          END; (* WHILE *)
          IF ch='E' THEN
            ReadExponent(exponent);
            x := x*exp10(exponent);
          END; (* IF *)
        ELSE (* ch#'.' *)
          done := FALSE;
        END; (* IF *)
      ELSE
        done := FALSE;
      END; (* IF *)
    IF sign THEN x := -x END;
    IF NOT done THEN
       x := dummy;
      (* conversion error *)
      error("ReadReal");
    END; (* IF *)
  END ReadReal;

END DemoRealInOut.