Subversion Repositories Kolibri OS

Rev

Go to most recent revision | Blame | Last modification | View Log | Download | RSS feed

  1. (*
  2.     BSD 2-Clause License
  3.  
  4.     Copyright (c) 2016, 2018, 2020-2021 Anton Krotov
  5.     All rights reserved.
  6. *)
  7.  
  8. MODULE Out;
  9.  
  10. IMPORT HOST, SYSTEM;
  11.  
  12.  
  13. PROCEDURE Char* (c: CHAR);
  14. BEGIN
  15.     HOST.OutChar(c)
  16. END Char;
  17.  
  18.  
  19. PROCEDURE String* (s: ARRAY OF CHAR);
  20. VAR
  21.     i, n: INTEGER;
  22.  
  23. BEGIN
  24.     n := LENGTH(s) - 1;
  25.     FOR i := 0 TO n DO
  26.         Char(s[i])
  27.     END
  28. END String;
  29.  
  30.  
  31. PROCEDURE Int* (x, width: INTEGER);
  32. VAR
  33.     i, a: INTEGER;
  34.     str: ARRAY 21 OF CHAR;
  35.  
  36. BEGIN
  37.     IF x = ROR(1, 1) THEN
  38.         str := "-9223372036854775808";
  39.         DEC(width, 20)
  40.     ELSE
  41.         i := 0;
  42.         IF x < 0 THEN
  43.             x := -x;
  44.             i := 1;
  45.             str[0] := "-"
  46.         END;
  47.  
  48.         a := x;
  49.         REPEAT
  50.             INC(i);
  51.             a := a DIV 10
  52.         UNTIL a = 0;
  53.  
  54.         str[i] := 0X;
  55.         DEC(width, i);
  56.  
  57.         REPEAT
  58.             DEC(i);
  59.             str[i] := CHR(x MOD 10 + ORD("0"));
  60.             x := x DIV 10
  61.         UNTIL x = 0
  62.     END;
  63.  
  64.     WHILE width > 0 DO
  65.         Char(20X);
  66.         DEC(width)
  67.     END;
  68.  
  69.     String(str)
  70. END Int;
  71.  
  72.  
  73. PROCEDURE IsNan (x: REAL): BOOLEAN;
  74. CONST
  75.     INF  = LSR(ASR(ROR(1, 1), 10), 1);
  76.     NINF = ASR(ASR(ROR(1, 1), 10), 1);
  77.  
  78. VAR
  79.     a: INTEGER;
  80.  
  81. BEGIN
  82.     SYSTEM.GET(SYSTEM.ADR(x), a)
  83.     RETURN (a > INF) OR (a < 0) & (a > NINF)
  84. END IsNan;
  85.  
  86.  
  87. PROCEDURE Inf (x: REAL; width: INTEGER);
  88. VAR
  89.     s: ARRAY 5 OF CHAR;
  90.  
  91. BEGIN
  92.     DEC(width, 4);
  93.     IF IsNan(x) THEN
  94.         s := " Nan"
  95.     ELSIF x = SYSTEM.INF() THEN
  96.         s := "+Inf"
  97.     ELSIF x = -SYSTEM.INF() THEN
  98.         s := "-Inf"
  99.     END;
  100.  
  101.     WHILE width > 0 DO
  102.         Char(20X);
  103.         DEC(width)
  104.     END;
  105.  
  106.     String(s)
  107. END Inf;
  108.  
  109.  
  110. PROCEDURE Ln*;
  111. BEGIN
  112.     Char(0DX);
  113.     Char(0AX)
  114. END Ln;
  115.  
  116.  
  117. PROCEDURE unpk10 (VAR x: REAL; VAR n: INTEGER);
  118. VAR
  119.     a, b: REAL;
  120.  
  121. BEGIN
  122.     ASSERT(x > 0.0);
  123.     n := 0;
  124.     WHILE x < 1.0 DO
  125.         x := x * 10.0;
  126.         DEC(n)
  127.     END;
  128.  
  129.     a := 10.0;
  130.     b := 1.0;
  131.  
  132.     WHILE a <= x DO
  133.         b := a;
  134.         a := a * 10.0;
  135.         INC(n)
  136.     END;
  137.     x := x / b
  138. END unpk10;
  139.  
  140.  
  141. PROCEDURE _Real (x: REAL; width: INTEGER);
  142. VAR
  143.     n, k, p: INTEGER;
  144.  
  145. BEGIN
  146.     p := MIN(MAX(width - 8, 1), 15);
  147.  
  148.     width := width - p - 8;
  149.     WHILE width > 0 DO
  150.         Char(20X);
  151.         DEC(width)
  152.     END;
  153.  
  154.     IF x < 0.0 THEN
  155.         Char("-");
  156.         x := -x
  157.     ELSE
  158.         Char(20X)
  159.     END;
  160.  
  161.     unpk10(x, n);
  162.  
  163.     k := FLOOR(x);
  164.     Char(CHR(k + 30H));
  165.     Char(".");
  166.  
  167.     WHILE p > 0 DO
  168.         x := (x - FLT(k)) * 10.0;
  169.         k := FLOOR(x);
  170.         Char(CHR(k + 30H));
  171.         DEC(p)
  172.     END;
  173.  
  174.     Char("E");
  175.     IF n >= 0 THEN
  176.         Char("+")
  177.     ELSE
  178.         Char("-")
  179.     END;
  180.     n := ABS(n);
  181.     Char(CHR(n DIV 100 + 30H)); n := n MOD 100;
  182.     Char(CHR(n DIV 10 + 30H));
  183.     Char(CHR(n MOD 10 + 30H))
  184. END _Real;
  185.  
  186.  
  187. PROCEDURE Real* (x: REAL; width: INTEGER);
  188. BEGIN
  189.     IF IsNan(x) OR (ABS(x) = SYSTEM.INF()) THEN
  190.         Inf(x, width)
  191.     ELSIF x = 0.0 THEN
  192.         WHILE width > 23 DO
  193.             Char(20X);
  194.             DEC(width)
  195.         END;
  196.         DEC(width, 9);
  197.         String(" 0.0");
  198.         WHILE width > 0 DO
  199.             Char("0");
  200.             DEC(width)
  201.         END;
  202.         String("E+000")
  203.     ELSE
  204.         _Real(x, width)
  205.     END
  206. END Real;
  207.  
  208.  
  209. PROCEDURE _FixReal (x: REAL; width, p: INTEGER);
  210. VAR
  211.     n, k: INTEGER;
  212.     minus: BOOLEAN;
  213.  
  214. BEGIN
  215.     minus := x < 0.0;
  216.     IF minus THEN
  217.         x := -x
  218.     END;
  219.  
  220.     unpk10(x, n);
  221.  
  222.     DEC(width, 3 + MAX(p, 0) + MAX(n, 0));
  223.     WHILE width > 0 DO
  224.         Char(20X);
  225.         DEC(width)
  226.     END;
  227.  
  228.     IF minus THEN
  229.         Char("-")
  230.     ELSE
  231.         Char(20X)
  232.     END;
  233.  
  234.     IF n < 0 THEN
  235.         INC(n);
  236.         Char("0");
  237.         Char(".");
  238.         WHILE (n < 0) & (p > 0) DO
  239.             Char("0");
  240.             INC(n);
  241.             DEC(p)
  242.         END
  243.     ELSE
  244.         WHILE n >= 0 DO
  245.             k := FLOOR(x);
  246.             Char(CHR(k + 30H));
  247.             x := (x - FLT(k)) * 10.0;
  248.             DEC(n)
  249.         END;
  250.         Char(".")
  251.     END;
  252.  
  253.     WHILE p > 0 DO
  254.         k := FLOOR(x);
  255.         Char(CHR(k + 30H));
  256.         x := (x - FLT(k)) * 10.0;
  257.         DEC(p)
  258.     END
  259.  
  260. END _FixReal;
  261.  
  262.  
  263. PROCEDURE FixReal* (x: REAL; width, p: INTEGER);
  264. BEGIN
  265.     IF IsNan(x) OR (ABS(x) = SYSTEM.INF()) THEN
  266.         Inf(x, width)
  267.     ELSIF x = 0.0 THEN
  268.         DEC(width, 3 + MAX(p, 0));
  269.         WHILE width > 0 DO
  270.             Char(20X);
  271.             DEC(width)
  272.         END;
  273.         String(" 0.");
  274.         WHILE p > 0 DO
  275.             Char("0");
  276.             DEC(p)
  277.         END
  278.     ELSE
  279.         _FixReal(x, width, p)
  280.     END
  281. END FixReal;
  282.  
  283.  
  284. PROCEDURE Open*;
  285. END Open;
  286.  
  287.  
  288. END Out.