Out.Real, Out.RealFix fixes

Programs/Kvad.Mod

@@ -0,0 +1,42 @@
+MODULE Kvad;
+IMPORT In, Out, Math;
+
+PROCEDURE Do;
+VAR a, b, c, D: REAL;
+BEGIN
+  Out.String('Решаем уравнение ax^2 + bx + c = 0'); Out.Ln;
+  Out.String('Введите a: '); In.Real(a);
+  Out.String('  Введите b: '); In.Real(b);
+  Out.String('    Введите c: '); In.Real(c);
+  IF a # 0.0 THEN
+    D := b * b - 4.0 * a * c;
+    IF D < 0.0 THEN
+      Out.String('Нет решений')
+    ELSIF D > 0.0 THEN
+      D := Math.sqrt(D);
+      Out.String('Два решения: ');
+      Out.RealFix((- b - D) / (2.0 * a), 0, 6); Out.Ln;
+      Out.String('             ');
+      Out.RealFix((- b + D) / (2.0 * a), 0, 6); Out.Ln
+    ELSE
+      Out.String('Единственное решение: ');
+      Out.RealFix(-0.5 * b / a, 0, 6)
+    END
+  ELSE (* a = 0 *)
+    IF b # 0.0 THEN
+      Out.String('Единственное решение: ');
+      Out.RealFix(-c / b, 0, 6)
+    ELSE (* a = b = 0 *)
+      IF c # 0.0 THEN
+        Out.String('Нет решений');
+      ELSE
+        Out.String('x - любое число')
+      END
+    END
+  END;
+  Out.Ln
+END Do;
+
+BEGIN
+  Do
+END Kvad.

Programs/Kvad2.Mod

@@ -0,0 +1,53 @@
+MODULE Kvad2;
+IMPORT In, Out, Math;
+
+PROCEDURE Do;
+VAR a, b, c, D: REAL;
+BEGIN
+  Out.String('Решаем уравнение ax^2 + bx + c = 0'); Out.Ln;
+  Out.String('Введите a: '); In.Real(a);
+  Out.String('  Введите b: '); In.Real(b);
+  Out.String('    Введите c: '); In.Real(c);
+  IF a # 0.0 THEN
+    D := b * b - 4.0 * a * c;
+    IF D < 0.0 THEN
+      Out.String('Нет решений')
+    ELSIF D > 0.0 THEN
+      Out.Real(D, 30); Out.Ln;
+      D := Math.sqrt(D);
+      Out.Real(a, 16); Out.Ln;
+      Out.Real(b, 16); Out.Ln;
+      Out.Real(c, 16); Out.Ln;
+      Out.Real(D, 30); Out.Ln;
+      Out.String('ЧТО ЗА     : ');
+      Out.Real((- 0.0 - D) / (2.0 * 4.0), 30); Out.Ln;
+      Out.String('ЧТО ЗА     : ');
+      Out.Real((- 0.0 - 8.0) / (2.0 * 4.0), 30); Out.Ln;
+      Out.String('Два решения: ');
+      Out.Real((- b - D) / (2.0 * a), 16); Out.Ln;
+      Out.Int(FLOOR((- b - D) / (2.0 * a)), 0); Out.Ln;
+      Out.String('             ');
+      Out.Real((- b + D) / (2.0 * a), 16);
+      Out.Ln; Out.Int(FLOOR((- b + D) / (2.0 * a)), 0); Out.Ln;
+    ELSE
+      Out.String('Единственное решение: ');
+      Out.Real(-0.5 * b / a, 16)
+    END
+  ELSE (* a = 0 *)
+    IF b # 0.0 THEN
+      Out.String('Единственное решение: ');
+      Out.Real(-c / b, 16)
+    ELSE (* a = b = 0 *)
+      IF c # 0.0 THEN
+        Out.String('Нет решений');
+      ELSE
+        Out.String('x - любое число')
+      END
+    END
+  END;
+  Out.Ln
+END Do;
+
+BEGIN
+  Do
+END Kvad2.

src/Graph.Mod

@@ -1344,7 +1344,7 @@ VAR a: Al.ADRINT;
 BEGIN
   a := Al.get_clipboard_text(win.display);
   (*IF a = 0 THEN a := Al.get_clipboard_text(win.display) END; (*Allegro bug*)*)
-  Out.String('PASTE DEBUG. a = ');Out.Int(a, 0);Out.Ln;
+  (*Out.String('PASTE DEBUG. a = ');Out.Int(a, 0);Out.Ln;*)
   IF a # 0 THEN p := SYSTEM.VAL(P, a); Utf8.Decode(p^, s);
     Al.free_with_context(a, 27, 'Graph.Mod', 'GetClipboardText')
     (*;Utf8.Encode('Привет', q);

src/Out.Mod

@@ -25,7 +25,6 @@ BEGIN
 END Flush;
 
 PROCEDURE Open*;
-BEGIN
 END Open;
 
 PROCEDURE Char*(ch: CHAR);
@@ -35,6 +34,10 @@ BEGIN
   IF ch = 0AX THEN Flush END
 END Char;
 
+PROCEDURE Spaces(n: INTEGER);
+BEGIN WHILE n > 0 DO Char(' '); DEC(n) END
+END Spaces;
+
 PROCEDURE Length(IN s: ARRAY OF CHAR): INTEGER;
 VAR n: INTEGER;
 BEGIN n := 0; WHILE (n < LEN(s)) & (s[n] # 0X) DO INC(n) END; RETURN n
@@ -69,6 +72,7 @@ BEGIN
   END
 END Utf8;
 
+(*
 PROCEDURE Int*(x, n: HUGEINT);
   CONST zero = ORD('0');
   VAR s: ARRAY 22 OF CHAR; i: INTEGER; negative: BOOLEAN;
@@ -103,6 +107,97 @@ BEGIN
     ELSE Char(SHORT(CHR((x MOD 16) - 10 + ORD('A')))) END
   END
 END Hex;
+*)
+
+PROCEDURE Int*(x, n: INTEGER);
+VAR i: INTEGER; x0: INTEGER;
+  a: ARRAY 10 OF CHAR;
+BEGIN
+  IF SYSTEM.ROT(*!FIXME ROR*)(x, 31) = 1 THEN
+    Spaces(n - 11); String('-2147483648')
+  ELSE i := 0;
+    IF x < 0 THEN DEC(n); x0 := -x ELSE x0 := x END;
+    REPEAT
+      a[i] := CHR(x0 MOD 10 + ORD('0')); x0 := x0 DIV 10; INC(i)
+    UNTIL x0 = 0;
+    WHILE n > i DO Char(' '); DEC(n) END;
+    IF x < 0 THEN Char('-') END;
+    REPEAT DEC(i); Char(a[i]) UNTIL i = 0
+  END
+END Int;
+
+PROCEDURE Hex*(x: INTEGER);
+VAR i: INTEGER; y: INTEGER;
+  a: ARRAY 10 OF CHAR;
+BEGIN i := 0; Char(' ');
+  REPEAT y := x MOD 10H;
+    IF y < 10 THEN a[i] := CHR(y + ORD('0'))
+    ELSE a[i] := CHR(y + (ORD('A') - 10))
+    END;
+    x := x DIV 10H; INC(i)
+  UNTIL i = 8;
+  REPEAT DEC(i); Char(a[i]) UNTIL i = 0
+END Hex;
+
+PROCEDURE Ten*(e: INTEGER): REAL;
+VAR r, power: REAL;
+BEGIN r := 1.0E0; power := 1.0E1;
+  WHILE e > 0 DO
+    IF ODD(e) THEN r := r * power END;
+    power := power * power; e := SHORT(e DIV 2)
+  END;
+RETURN r END Ten;
+
+PROCEDURE Real*(x: REAL; n: INTEGER);
+VAR e, i, k, m: INTEGER;
+  d: ARRAY 16 OF CHAR;
+BEGIN e := ASH(SYSTEM.VAL(INTEGER, x), -23) MOD 100H; (* Binary exponent *)
+  IF e = 0 THEN Spaces(n - 1); Char('0')
+  ELSIF e = 255 THEN Spaces(n - 4); String(' NaN')
+  ELSE Char(' ');
+    WHILE n >= 15 DO DEC(n); Char(' ') END;
+    (* 2 < n < 9 digits to be written *)
+    IF x < 0.0 THEN Char('-'); x := -x ELSE Char(' ') END;
+    e := (e - 127) * 77 DIV 256 - 6; (* Decimal exponent *)
+    IF e >= 0 THEN x := x / Ten(e) ELSE x := Ten(-e) * x END;
+    m := SHORT(ENTIER(x + 0.5));
+    IF m >= 10000000 THEN INC(e); m := m DIV 10 END;
+    i := 0; k := 13 - n;
+    REPEAT
+      IF i = k THEN INC(m, 5) END; (* Rounding *)
+      d[i] := CHR(m MOD 10 + ORD('0')); m := m DIV 10; INC(i)
+    UNTIL m = 0;
+    DEC(i); Char(d[i]); Char('.');
+    IF i < n - 7 THEN n := 0 ELSE n := 14 - n END;
+    WHILE i > n DO DEC(i); Char(d[i]) END;
+    Char('E'); INC(e, 6);
+    IF e < 0 THEN Char('-'); e := -e ELSE Char('+') END;
+    Char(CHR(e DIV 10 + ORD('0'))); Char(CHR(e MOD 10 + ORD('0')))
+  END
+END Real;
+
+PROCEDURE RealFix*(x: REAL; n, k: INTEGER);
+VAR i, m: INTEGER; neg: BOOLEAN;
+  d: ARRAY 12 OF CHAR;
+BEGIN
+  IF x = 0.0 THEN DEC(n);
+    WHILE n # 0 DO Char(' '); DEC(n) END;
+    Char('0')
+  ELSE
+    IF x < 0.0 THEN x := -x; neg := TRUE ELSE neg := FALSE END;
+    IF k > 7 THEN k := 7 END;
+    x := Ten(k) * x; m := SHORT(ENTIER(x + 0.5));
+    i := 0;
+    REPEAT d[i] := CHR(m MOD 10 + ORD('0')); m := m DIV 10; INC(i) UNTIL m = 0;
+    Char(' ');
+    WHILE n > i + 3 DO Char(' '); DEC(n) END;
+    IF neg THEN Char('-'); DEC(n) ELSE Char(' ') END;
+    WHILE i > k DO DEC(i); Char(d[i]) END;
+    Char('.');
+    WHILE k > i DO DEC(k); Char('0') END;
+    WHILE i > 0 DO DEC(i); Char(d[i]) END
+  END
+END RealFix;
 
 PROCEDURE Ln*;
 BEGIN String(Platform.NewLine); Flush
@@ -114,129 +209,13 @@ BEGIN
 END digit;
 
 PROCEDURE prepend(IN t: ARRAY OF CHAR; VAR s: ARRAY OF CHAR; VAR i: INTEGER);
-  VAR j: INTEGER; l: INTEGER;
+VAR j: INTEGER; l: INTEGER;
 BEGIN
   l := Length(t); IF l > i THEN l := i END;
   DEC(i, SHORT(l)); j := 0;
   WHILE j < l DO s[i+j] := t[j]; INC(j) END
 END prepend;
 
-PROCEDURE Ten*(e: INTEGER): LONGREAL;
-VAR r, power: LONGREAL;
-BEGIN r := 1.0E0; power := 1.0E1;
-  WHILE e > 0 DO
-    IF ODD(e) THEN r := r*power END;
-    power := power*power; e := SHORT(e DIV 2)
-  END;
-  RETURN r
-END Ten;
-
-PROCEDURE -Entier64(x: LONGREAL): SYSTEM.INT64 "(LONGINT)(x)";
-
-PROCEDURE RealP(x: LONGREAL; n: INTEGER; long: BOOLEAN);
-
-(* RealP(x, n) writes the long real number x to the end of the output stream using an
-   exponential form. If the textual representation of x requires m characters (including  a
-   three-digit signed exponent), x is right adjusted in a field of Max(n, m) characters padded
-   with blanks at the left end. A plus sign of the mantissa is not written.
-   LONGREAL is 1/sign, 11/exponent, 52/significand *)
-
-VAR
-  e:   SHORTINT;         (* Exponent field *)
-  f:   HUGEINT;          (* Fraction field *)
-  s:   ARRAY 30 OF CHAR; (* Buffer built backwards *)
-  i:   INTEGER;          (* Index into s *)
-  el:  INTEGER;          (* Exponent length *)
-  x0:  LONGREAL;
-  nn:  BOOLEAN;          (* Number negative *)
-  en:  BOOLEAN;          (* Exponent negative *)
-  m:   HUGEINT;          (* Mantissa digits *)
-  d:   INTEGER;          (* Significant digit count to display *)
-  dr:  INTEGER;          (* Number of insignificant digits that can be dropped *)
-
-BEGIN
-  e  := SYSTEM.VAL(SHORTINT, (SYSTEM.VAL(HUGEINT, x) DIV 10000000000000L) MOD 800H);
-  f  := SYSTEM.VAL(HUGEINT, x) MOD 10000000000000L;
-  nn := (SYSTEM.VAL(HUGEINT, x) < 0) & ~((e = 7FFH) & (f # 0)); (* Ignore sign on Nan *)
-  IF nn THEN DEC(n) END;
-
-  i := LEN(s);
-  IF e = 7FFH THEN (* NaN / Infinity *)
-    IF f = 0 THEN prepend("Infinity", s, i) ELSE prepend("NaN", s, i) END
-  ELSE
-    (* Calculate number of significant digits caller has proposed space for, and
-       number of digits to generate. *)
-    IF long THEN
-      el := 3;
-      dr := SHORT(n-6);             (* Leave room for dp and '+D000' *)
-      IF dr > 17 THEN dr := 17 END; (* Limit to max useful significant digits *)
-      d := dr;                      (* Number of digits to generate *)
-      IF d < 15 THEN d := 15 END    (* Generate enough digits to do trailing zero supporession *)
-    ELSE
-      el := 2;
-      dr := SHORT(n-5);             (* Leave room for dp and '+E00' *)
-      IF dr > 9 THEN dr := 9 END;   (* Limit to max useful significant digits *)
-      d := dr;                      (* Number of digits to generate *)
-      IF d < 6 THEN d := 6 END      (* Generate enough digits to do trailing zero supporession *)
-    END;
-
-    IF e = 0 THEN
-      WHILE el > 0 DO DEC(i); s[i] := "0"; DEC(el) END;
-      DEC(i); s[i] := "+";
-      m := 0;
-    ELSE
-      IF nn THEN x := -x END;
-
-      (* Scale e to be an exponent of 10 rather than 2 *)
-      e := SHORT(SHORT(LONG(e - 1023) * 77 DIV 256));
-      IF e >= 0 THEN x := x / Ten(e) ELSE x := Ten(SHORT(-e)) * x END ;
-      IF x >= 10.0E0 THEN x := 0.1E0 * x; INC(e) END;
-
-      (* Generate the exponent digits *)
-      en := e < 0; IF en THEN e := SHORT(-e) END;
-      WHILE el > 0 DO digit(e, s, i); e := SHORT(e DIV 10); DEC(el) END;
-      DEC(i); IF en THEN s[i] := "-" ELSE s[i] := "+" END;
-
-      (* Scale x to enough significant digits to reliably test for trailing
-         zeroes or to the amount of space available, if greater. *)
-      x0 := Ten(SHORT(d-1));
-      x  := x0 * x;
-      x  := x + 0.5E0; (* Do not combine with previous line as doing so
-                          introduces a least significant bit difference
-                          between 32 bit and 64 bit builds. *)
-      IF x >= 10.0E0 * x0 THEN x := 0.1E0 * x; INC(e) END;
-      m := Entier64(x)
-    END;
-
-    DEC(i); IF long THEN s[i] := "D" ELSE s[i] := "E" END;
-
-    (* Drop trailing zeroes where caller proposes to use less space *)
-    IF dr < 2 THEN dr := 2 END;
-    WHILE (d > dr) & (m MOD 10 = 0) DO m := m DIV 10; DEC(d) END;
-
-    (* Render significant digits *)
-    WHILE d > 1 DO digit(m, s, i); m := m DIV 10; DEC(d) END;
-    DEC(i); s[i] := '.';
-    digit(m, s, i);
-  END;
-
-  (* Generate leading padding *)
-  DEC(n, SHORT(LEN(s)-i)); WHILE n > 0 DO Char(" "); DEC(n) END;
-
-  (* Render prepared number from right end of buffer s *)
-  IF nn THEN Char("-") END;
-  WHILE i < LEN(s) DO Char(s[i]); INC(i) END
-END RealP;
-
-
-PROCEDURE Real*(x: REAL; n: INTEGER);
-BEGIN RealP(x, n, FALSE)
-END Real;
-
-PROCEDURE LongReal*(x: LONGREAL; n: INTEGER);
-BEGIN RealP(x, n, TRUE)
-END LongReal;
-
 (* Convert LONGREAL: Write positive integer value of x into array d.
    The value is stored backwards, i.e. least significant digit
    first. n digits are written, with trailing zeros fill.
@@ -274,53 +253,6 @@ BEGIN
   RETURN i DIV 128 MOD 256
 END Expo;
 
-PROCEDURE RealFix*(x: REAL; n, k: INTEGER);
-CONST maxD = 9;
-VAR e, i, minus, p: INTEGER; x0: REAL;
-  d: ARRAY maxD OF CHAR;
-
-  PROCEDURE seq(ch: CHAR; n: INTEGER);
-  BEGIN WHILE n > 0 DO Char(ch); DEC(n) END
-  END seq;
-
-  PROCEDURE dig(n: INTEGER);
-  BEGIN WHILE n > 0 DO DEC(i); Char(d[i]); DEC(n) END
-  END dig;
-
-BEGIN e := Expo(x);
-  IF k < 0 THEN k := 0 END;
-  IF e = 0 THEN seq(' ', SHORT(n-k-2)); Char('0'); seq(' ', SHORT(k + 1))
-  ELSIF e = 255 THEN String(' NaN'); seq(' ', SHORT(n - 4))
-  ELSE e := (e - 127) * 77 DIV 256;
-    IF x < 0 THEN minus := 1; x := -x ELSE minus := 0 END;
-    IF e >= 0 THEN  (*x >= 1.0,  77/256 = log 2*) x := SHORT(x / Ten(e))
-      ELSE (*x < 1.0*) x := SHORT(Ten(SHORT(-e)) * x)
-    END;
-    IF x >= 10.0 THEN x := 0.1 * x; INC(e) END;
-    (* 1 <= x < 10 *)
-    IF k + e >= maxD - 1 THEN k := SHORT(maxD - 1 - e)
-    ELSIF k + e < 0 THEN k := SHORT(-e); x := 0.0
-    END;
-    x0 := SHORT(Ten(SHORT(k + e))); x := x0 * x + 0.5;
-    IF x >= 10.0 * x0 THEN INC(e) END;
-    (*e = no. of digits before decimal point*)
-    INC(e); i := k + e; ConvertL(x, i, d);
-    IF e > 0 THEN
-      IF k > 0 THEN p := 0 ELSE p := 1 END;
-      seq(' ', n - e - k - 1 - minus + p);
-      IF minus # 0 THEN Char('-') END;
-      dig(e);
-      IF k > 0 THEN Char('.'); dig(k) END
-    ELSE
-      IF k + e > 0 THEN p := 0 ELSE p := 1 END;
-      seq(' ', n - k - 2 - minus + p);
-      IF minus # 0 THEN Char('-') END;
-      Char('0');
-      IF k + e > 0 THEN Char('.'); seq('0', -e); dig(k + e) END
-    END
-  END
-END RealFix;
-
 BEGIN
   IsConsole := Platform.IsConsole(Platform.StdOut);
   in := 0