ruberon/lib/RVMxI/32/Out.ob07

(*
    BSD 2-Clause License

    Copyright (c) 2016, 2018, 2020, Anton Krotov
    All rights reserved.
*)

MODULE Out;

IMPORT HOST, SYSTEM;


PROCEDURE Char* (c: CHAR);
BEGIN
    HOST.OutChar(c)
END Char;


PROCEDURE String* (s: ARRAY OF CHAR);
VAR
    i, n: INTEGER;

BEGIN
    n := LENGTH(s) - 1;
    FOR i := 0 TO n DO
        Char(s[i])
    END
END String;


PROCEDURE Int* (x, width: INTEGER);
VAR
    i, a: INTEGER;
    str: ARRAY 12 OF CHAR;

BEGIN
    IF x = 80000000H THEN
        COPY("-2147483648", str);
        DEC(width, 11)
    ELSE
        i := 0;
        IF x < 0 THEN
            x := -x;
            i := 1;
            str[0] := "-"
        END;

        a := x;
        REPEAT
            INC(i);
            a := a DIV 10
        UNTIL a = 0;

        str[i] := 0X;
        DEC(width, i);

        REPEAT
            DEC(i);
            str[i] := CHR(x MOD 10 + ORD("0"));
            x := x DIV 10
        UNTIL x = 0
    END;

    WHILE width > 0 DO
        Char(20X);
        DEC(width)
    END;

    String(str)
END Int;


PROCEDURE Inf (x: REAL; width: INTEGER);
VAR
    s: ARRAY 5 OF CHAR;

BEGIN
    DEC(width, 4);
    IF x # x THEN
        s := " Nan"
    ELSIF x = SYSTEM.INF() THEN
        s := "+Inf"
    ELSIF x = -SYSTEM.INF() THEN
        s := "-Inf"
    END;

    WHILE width > 0 DO
        Char(20X);
        DEC(width)
    END;

    String(s)
END Inf;


PROCEDURE Ln*;
BEGIN
    Char(0DX);
    Char(0AX)
END Ln;


PROCEDURE unpk10 (VAR x: REAL; VAR n: INTEGER);
VAR
    a, b: REAL;

BEGIN
    ASSERT(x > 0.0);
    n := 0;
    WHILE x < 1.0 DO
        x := x * 10.0;
        DEC(n)
    END;

    a := 10.0;
    b := 1.0;

    WHILE a <= x DO
        b := a;
        a := a * 10.0;
        INC(n)
    END;
    x := x / b
END unpk10;


PROCEDURE _Real (x: REAL; width: INTEGER);
VAR
    n, k, p: INTEGER;

BEGIN
    p := MIN(MAX(width - 7, 1), 10);

    width := width - p - 7;
    WHILE width > 0 DO
        Char(20X);
        DEC(width)
    END;

    IF x < 0.0 THEN
        Char("-");
        x := -x
    ELSE
        Char(20X)
    END;

    unpk10(x, n);

    k := FLOOR(x);
    Char(CHR(k + 30H));
    Char(".");

    WHILE p > 0 DO
        x := (x - FLT(k)) * 10.0;
        k := FLOOR(x);
        Char(CHR(k + 30H));
        DEC(p)
    END;

    Char("E");
    IF n >= 0 THEN
        Char("+")
    ELSE
        Char("-")
    END;
    n := ABS(n);
    Char(CHR(n DIV 10 + 30H));
    Char(CHR(n MOD 10 + 30H))
END _Real;


PROCEDURE Real* (x: REAL; width: INTEGER);
BEGIN
    IF (x # x) OR (ABS(x) = SYSTEM.INF()) THEN
        Inf(x, width)
    ELSIF x = 0.0 THEN
        WHILE width > 17 DO
            Char(20X);
            DEC(width)
        END;
        DEC(width, 8);
        String(" 0.0");
        WHILE width > 0 DO
            Char("0");
            DEC(width)
        END;
        String("E+00")
    ELSE
        _Real(x, width)
    END
END Real;


PROCEDURE _FixReal (x: REAL; width, p: INTEGER);
VAR
    n, k: INTEGER;
    minus: BOOLEAN;

BEGIN
    minus := x < 0.0;
    IF minus THEN
        x := -x
    END;

    unpk10(x, n);

    DEC(width, 3 + MAX(p, 0) + MAX(n, 0));
    WHILE width > 0 DO
        Char(20X);
        DEC(width)
    END;

    IF minus THEN
        Char("-")
    ELSE
        Char(20X)
    END;

    IF n < 0 THEN
        INC(n);
        Char("0");
        Char(".");
        WHILE (n < 0) & (p > 0) DO
            Char("0");
            INC(n);
            DEC(p)
        END
    ELSE
        WHILE n >= 0 DO
            k := FLOOR(x);
            Char(CHR(k + 30H));
            x := (x - FLT(k)) * 10.0;
            DEC(n)
        END;
        Char(".")
    END;

    WHILE p > 0 DO
        k := FLOOR(x);
        Char(CHR(k + 30H));
        x := (x - FLT(k)) * 10.0;
        DEC(p)
    END

END _FixReal;


PROCEDURE FixReal* (x: REAL; width, p: INTEGER);
BEGIN
    IF (x # x) OR (ABS(x) = SYSTEM.INF()) THEN
        Inf(x, width)
    ELSIF x = 0.0 THEN
        DEC(width, 3 + MAX(p, 0));
        WHILE width > 0 DO
            Char(20X);
            DEC(width)
        END;
        String(" 0.");
        WHILE p > 0 DO
            Char("0");
            DEC(p)
        END
    ELSE
        _FixReal(x, width, p)
    END
END FixReal;


PROCEDURE Open*;
END Open;


END Out.