Subversion Repositories Kolibri OS

(*

    BSD 2-Clause License

    Copyright (c) 2018, 2019, Anton Krotov

    All rights reserved.

*)

MODULE ARITH;

IMPORT AVLTREES, STRINGS, MACHINE, UTILS;

CONST

    tINTEGER* = 1;  tREAL* = 2;  tSET*    = 3;

    tBOOLEAN* = 4;  tCHAR* = 5;  tWCHAR*  = 6;

    tSTRING*  = 7;

TYPE

    RELATION* = ARRAY 3 OF CHAR;

    VALUE* = RECORD

        typ*:      INTEGER;

        int:       INTEGER;

        float:     REAL;

        set:       SET;

        bool:      BOOLEAN;

        string*:   AVLTREES.DATA

    END;

VAR

    digit: ARRAY 256 OF INTEGER;

PROCEDURE Int* (v: VALUE): INTEGER;

VAR

    res: INTEGER;

BEGIN

    IF v.typ = tINTEGER THEN

        res := v.int

    ELSIF v.typ = tCHAR THEN

        res := v.int

    ELSIF v.typ = tWCHAR THEN

        res := v.int

    ELSIF v.typ = tSET THEN

        res := ORD(v.set);

        IF MACHINE._64to32 THEN

            res := MACHINE.Int32To64(res)

        END

    ELSIF v.typ = tBOOLEAN THEN

        res := ORD(v.bool)

    END

    RETURN res

END Int;

PROCEDURE getBool* (v: VALUE): BOOLEAN;

BEGIN

    ASSERT(v.typ = tBOOLEAN);

    RETURN v.bool

END getBool;

PROCEDURE Float* (v: VALUE): REAL;

BEGIN

    ASSERT(v.typ = tREAL);

    RETURN v.float

END Float;

PROCEDURE check* (v: VALUE): BOOLEAN;

VAR

    error: BOOLEAN;

BEGIN

    error := FALSE;

    IF (v.typ = tINTEGER) & ((v.int < MACHINE.target.minInt) OR (v.int > MACHINE.target.maxInt)) THEN

        error := TRUE

    ELSIF (v.typ = tCHAR) & ((v.int < 0) OR (v.int > 255)) THEN

        error := TRUE

    ELSIF (v.typ = tWCHAR) & ((v.int < 0) OR (v.int > 65535)) THEN

        error := TRUE

    ELSIF (v.typ = tREAL) & ((v.float < -MACHINE.target.maxReal) OR (v.float > MACHINE.target.maxReal)) THEN

        error := TRUE

    END

    RETURN ~error

END check;

PROCEDURE isZero* (v: VALUE): BOOLEAN;

VAR

    res: BOOLEAN;

BEGIN

    ASSERT(v.typ IN {tINTEGER, tREAL});

    IF v.typ = tINTEGER THEN

        res := v.int = 0

    ELSIF v.typ = tREAL THEN

        res := v.float = 0.0

    END

    RETURN res

END isZero;

PROCEDURE iconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);

VAR

    value: INTEGER;

    i:     INTEGER;

    d:     INTEGER;

BEGIN

    error := 0;

    value := 0;

    i := 0;

    WHILE STRINGS.digit(s[i]) & (error = 0) DO

        d := digit[ORD(s[i])];

        IF value <= (UTILS.maxint - d) DIV 10 THEN

            value := value * 10 + d;

            INC(i)

        ELSE

            error := 1

        END

    END;

    IF error = 0 THEN

        v.int := value;

        v.typ := tINTEGER;

        IF ~check(v) THEN

            error := 1

        END

    END

END iconv;

PROCEDURE hconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);

VAR

    value: INTEGER;

    i:     INTEGER;

    n:     INTEGER;

    d:     INTEGER;

BEGIN

    ASSERT(STRINGS.digit(s[0]));

    error := 0;

    value := 0;

    n := -1;

    i := 0;

    WHILE (s[i] # "H") & (s[i] # "X") & (error = 0) DO

        d := digit[ORD(s[i])];

        IF (n = -1) & (d # 0) THEN

            n := i

        END;

        IF (n # -1) & (i - n + 1 > MACHINE.target.maxHex) THEN

            error := 2

        ELSE

            value := value * 16 + d;

            INC(i)

        END

    END;

    IF MACHINE._64to32 THEN

        value := MACHINE.Int32To64(value);

    END;

    IF (s[i] = "X") & (n # -1) & (i - n > 4) THEN

        error := 3

    END;

    IF error = 0 THEN

        v.int := value;

        IF s[i] = "X" THEN

            v.typ := tCHAR;

            IF ~check(v) THEN

                v.typ := tWCHAR;

                IF ~check(v) THEN

                    error := 3

                END

            END

        ELSE

            v.typ := tINTEGER;

            IF ~check(v) THEN

                error := 2

            END

        END

    END

END hconv;

PROCEDURE opFloat2 (VAR a: REAL; b: REAL; op: CHAR): BOOLEAN;

VAR

    max: REAL;

    res: BOOLEAN;

BEGIN

    max := UTILS.maxreal;

    CASE op OF

    |"+":

        IF (a < 0.0) & (b < 0.0) THEN

            res := a > -max - b

        ELSIF (a > 0.0) & (b > 0.0) THEN

            res := a <  max - b

        ELSE

            res := TRUE

        END;

        IF res THEN

            a := a + b

        END

    |"-":

        IF (a < 0.0) & (b > 0.0) THEN

            res := a > b - max

        ELSIF (a > 0.0) & (b < 0.0) THEN

            res := a < b + max

        ELSE

            res := TRUE

        END;

        IF res THEN

            a := a - b

        END

    |"*":

        IF (ABS(a) > 1.0) & (ABS(b) > 1.0) THEN

            res := ABS(a) < max / ABS(b)

        ELSE

            res := TRUE

        END;

        IF res THEN

            a := a * b

        END

    |"/":

        IF ABS(b) < 1.0 THEN

            res := ABS(a) < max * ABS(b)

        ELSE

            res := TRUE

        END;

        IF res THEN

            a := a / b

        END

    END

    RETURN res

END opFloat2;

PROCEDURE fconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);

VAR

    value:    REAL;

    exp10:    REAL;

    i, n, d:  INTEGER;

    minus:    BOOLEAN;

BEGIN

    error := 0;

    value := 0.0;

    exp10 := 10.0;

    minus := FALSE;

    n := 0;

    i := 0;

    WHILE (error = 0) & STRINGS.digit(s[i]) DO

        IF opFloat2(value, 10.0, "*") & opFloat2(value, FLT(digit[ORD(s[i])]), "+") THEN

            INC(i)

        ELSE

            error := 4

        END

    END;

    INC(i);

    WHILE (error = 0) & STRINGS.digit(s[i]) DO

        IF opFloat2(value, FLT(digit[ORD(s[i])]) / exp10, "+") & opFloat2(exp10, 10.0, "*") THEN

            INC(i)

        ELSE

            error := 4

        END

    END;

    IF s[i] = "E" THEN

        INC(i)

    END;

    IF (s[i] = "-") OR (s[i] = "+") THEN

        minus := s[i] = "-";

        INC(i)

    END;

    WHILE (error = 0) & STRINGS.digit(s[i]) DO

        d := digit[ORD(s[i])];

        IF n <= (UTILS.maxint - d) DIV 10 THEN

            n := n * 10 + d;

            INC(i)

        ELSE

            error := 5

        END

    END;

    exp10 := 1.0;

    WHILE (error = 0) & (n > 0) DO

        IF opFloat2(exp10, 10.0, "*") THEN

            DEC(n)

        ELSE

            error := 4

        END

    END;

    IF error = 0 THEN

        IF minus THEN

            IF ~opFloat2(value, exp10, "/") THEN

                error := 4

            END

        ELSE

            IF ~opFloat2(value, exp10, "*") THEN

                error := 4

            END

        END

    END;

    IF error = 0 THEN

        v.float := value;

        v.typ := tREAL;

        IF ~check(v) THEN

            error := 4

        END

    END

END fconv;

PROCEDURE setChar* (VAR v: VALUE; ord: INTEGER);

BEGIN

    v.typ := tCHAR;

    v.int := ord

END setChar;

PROCEDURE setWChar* (VAR v: VALUE; ord: INTEGER);

BEGIN

    v.typ := tWCHAR;

    v.int := ord

END setWChar;

PROCEDURE addInt (VAR a: INTEGER; b: INTEGER): BOOLEAN;

VAR

    error: BOOLEAN;

BEGIN

    IF (a > 0) & (b > 0) THEN

        error := a > UTILS.maxint - b

    ELSIF (a < 0) & (b < 0) THEN

        error := a < UTILS.minint - b

    ELSE

        error := FALSE

    END;

    IF ~error THEN

        a := a + b

    ELSE

        a := 0

    END

    RETURN ~error

END addInt;

PROCEDURE subInt (VAR a: INTEGER; b: INTEGER): BOOLEAN;

VAR

    error: BOOLEAN;

BEGIN

    IF (a > 0) & (b < 0) THEN

        error := a > UTILS.maxint + b

    ELSIF (a < 0) & (b > 0) THEN

        error := a < UTILS.minint + b

    ELSIF (a = 0) & (b < 0) THEN

        error := b = UTILS.minint

    ELSE

        error := FALSE

    END;

    IF ~error THEN

        a := a - b

    ELSE

        a := 0

    END

    RETURN ~error

END subInt;

PROCEDURE lg2 (x: INTEGER): INTEGER;

VAR

    n: INTEGER;

BEGIN

    ASSERT(x > 0);

    n := 0;

    WHILE ~ODD(x) DO

        x := x DIV 2;

        INC(n)

    END;

    IF x # 1 THEN

        n := 255

    END

    RETURN n

END lg2;

PROCEDURE mulInt* (VAR a: INTEGER; b: INTEGER): BOOLEAN;

VAR

    error:    BOOLEAN;

    min, max: INTEGER;

BEGIN

    min := UTILS.minint;

    max := UTILS.maxint;

    IF ((a > 1) & (b > 1)) OR ((a < 0) & (b < 0)) THEN

        error := (a = min) OR (b = min) OR (ABS(a) > max DIV ABS(b))

    ELSIF ((a > 1) & (b < 0)) OR ((a < 0) & (b > 1)) THEN

        error := (a = min) OR (b = min);

        IF ~error THEN

            IF lg2(ABS(a)) + lg2(ABS(b)) >= UTILS.bit_depth THEN

                error := ABS(a) > max DIV ABS(b)

            END

        END

    ELSE

        error := FALSE

    END;

    IF ~error THEN

        a := a * b

    ELSE

        a := 0

    END

    RETURN ~error

END mulInt;

PROCEDURE _ASR (x, n: INTEGER): INTEGER;

BEGIN

    IF MACHINE._64to32 THEN

        x := MACHINE.Int32To64(x)

    END

    RETURN ASR(x, n)

END _ASR;

PROCEDURE _LSR (x, n: INTEGER): INTEGER;

BEGIN

    IF MACHINE._64to32 THEN

        x := MACHINE.Int64To32(x);

        x := LSR(x, n);

        x := MACHINE.Int32To64(x)

    ELSE

        x := LSR(x, n)

    END

    RETURN x

END _LSR;

PROCEDURE _LSL (x, n: INTEGER): INTEGER;

BEGIN

    x := LSL(x, n);

    IF MACHINE._64to32 THEN

        x := MACHINE.Int32To64(x)

    END

    RETURN x

END _LSL;

PROCEDURE _ROR1_32 (x: INTEGER): INTEGER;

BEGIN

    x := MACHINE.Int64To32(x);

    x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 31)))

    RETURN MACHINE.Int32To64(x)

END _ROR1_32;

PROCEDURE _ROR (x, n: INTEGER): INTEGER;

BEGIN

    IF MACHINE._64to32 THEN

        n := n MOD 32;

        WHILE n > 0 DO

            x := _ROR1_32(x);

            DEC(n)

        END

    ELSE

        x := ROR(x, n)

    END

    RETURN x

END _ROR;

PROCEDURE opInt* (VAR a: VALUE; b: VALUE; op: CHAR): BOOLEAN;

VAR

    success: BOOLEAN;

BEGIN

    success := TRUE;

    CASE op OF

    |"+": success := addInt(a.int, b.int)

    |"-": success := subInt(a.int, b.int)

    |"*": success := mulInt(a.int, b.int)

    |"/": success := FALSE

    |"D": IF (b.int # -1) OR (a.int # UTILS.minint) THEN a.int := a.int DIV b.int ELSE success := FALSE END

    |"M": a.int := a.int MOD b.int

    |"L": a.int := _LSL(a.int, b.int)

    |"A": a.int := _ASR(a.int, b.int)

    |"O": a.int := _ROR(a.int, b.int)

    |"R": a.int := _LSR(a.int, b.int)

    |"m": a.int := MIN(a.int, b.int)

    |"x": a.int := MAX(a.int, b.int)

    END;

    a.typ := tINTEGER

    RETURN success & check(a)

END opInt;

PROCEDURE charToStr* (c: VALUE; VAR s: ARRAY OF CHAR);

BEGIN

    s[0] := CHR(c.int);

    s[1] := 0X

END charToStr;

PROCEDURE opSet* (VAR a: VALUE; b: VALUE; op: CHAR);

BEGIN

    CASE op OF

    |"+": a.set := a.set + b.set

    |"-": a.set := a.set - b.set

    |"*": a.set := a.set * b.set

    |"/": a.set := a.set / b.set

    END;

    a.typ := tSET

END opSet;

PROCEDURE opFloat* (VAR a: VALUE; b: VALUE; op: CHAR): BOOLEAN;

BEGIN

    a.typ := tREAL

    RETURN opFloat2(a.float, b.float, op) & check(a)

END opFloat;

PROCEDURE ord* (VAR v: VALUE);

BEGIN

    CASE v.typ OF

    |tCHAR, tWCHAR:

    |tBOOLEAN: v.int := ORD(v.bool)

    |tSET:

        v.int := ORD(v.set);

        IF MACHINE._64to32 THEN

            v.int := MACHINE.Int32To64(v.int)

        END

    END;

    v.typ := tINTEGER

END ord;

PROCEDURE odd* (VAR v: VALUE);

BEGIN

    v.typ := tBOOLEAN;

    v.bool := ODD(v.int)

END odd;

PROCEDURE bits* (VAR v: VALUE);

BEGIN

    v.typ := tSET;

    v.set := BITS(v.int)

END bits;

PROCEDURE abs* (VAR v: VALUE): BOOLEAN;

VAR

    res: BOOLEAN;

BEGIN

    res := FALSE;

    CASE v.typ OF

    |tREAL:

        v.float := ABS(v.float);

        res := TRUE

    |tINTEGER:

        IF v.int # UTILS.minint THEN

            v.int := ABS(v.int);

            res := TRUE

        END

    END

    RETURN res

END abs;

PROCEDURE floor* (VAR v: VALUE): BOOLEAN;

VAR

    res: BOOLEAN;

BEGIN

    v.typ := tINTEGER;

    res := (FLT(UTILS.minint) <= v.float) & (v.float <= FLT(UTILS.maxint));

    IF res THEN

        v.int := FLOOR(v.float)

    END

    RETURN res

END floor;

PROCEDURE flt* (VAR v: VALUE);

BEGIN

    v.typ := tREAL;

    v.float := FLT(v.int)

END flt;

PROCEDURE neg* (VAR v: VALUE): BOOLEAN;

VAR

    z: VALUE;

    res: BOOLEAN;

BEGIN

    res := TRUE;

    z.typ := tINTEGER;

    z.int := 0;

    CASE v.typ OF

    |tREAL:     v.float := -v.float

    |tSET:      v.set := -v.set

    |tINTEGER:  res := opInt(z, v, "-"); v := z

    |tBOOLEAN:  v.bool := ~v.bool

    END

    RETURN res

END neg;

PROCEDURE setbool* (VAR v: VALUE; b: BOOLEAN);

BEGIN

    v.bool := b;

    v.typ := tBOOLEAN

END setbool;

PROCEDURE opBoolean* (VAR a: VALUE; b: VALUE; op: CHAR);

BEGIN

    CASE op OF

    |"&": a.bool := a.bool & b.bool

    |"|": a.bool := a.bool OR b.bool

    END;

    a.typ := tBOOLEAN

END opBoolean;

PROCEDURE range* (i: VALUE; a, b: INTEGER): BOOLEAN;

    RETURN (a <= i.int) & (i.int <= b)

END range;

PROCEDURE less (v, v2: VALUE; VAR error: INTEGER): BOOLEAN;

VAR

    res: BOOLEAN;

BEGIN

    res := FALSE;

    IF (v.typ = v2.typ) OR (v.typ IN {tCHAR, tWCHAR}) & (v2.typ IN {tCHAR, tWCHAR}) THEN

        CASE v.typ OF

        |tINTEGER,

         tWCHAR,

         tCHAR:     res := v.int < v2.int

        |tREAL:     res := v.float < v2.float

        |tBOOLEAN,

         tSET:      error := 1

        END

    ELSE

        error := 1

    END

    RETURN res

END less;

PROCEDURE equal (v, v2: VALUE; VAR error: INTEGER): BOOLEAN;

VAR

    res: BOOLEAN;

BEGIN

    res := FALSE;

    IF (v.typ = v2.typ) OR (v.typ IN {tCHAR, tWCHAR}) & (v2.typ IN {tCHAR, tWCHAR}) THEN

        CASE v.typ OF

        |tINTEGER,

         tWCHAR,

         tCHAR:     res := v.int = v2.int

        |tREAL:     res := v.float = v2.float

        |tBOOLEAN:  res := v.bool = v2.bool

        |tSET:      res := v.set = v2.set

        END

    ELSE

        error := 1

    END

    RETURN res

END equal;

PROCEDURE relation* (VAR v: VALUE; v2: VALUE; operator: RELATION; VAR error: INTEGER);

VAR

    res: BOOLEAN;

BEGIN

    error := 0;

    res := FALSE;

    CASE operator[0] OF

    |"=":

        res := equal(v, v2, error)

    |"#":

        res := ~equal(v, v2, error)

    |"<":

        IF operator[1] = "=" THEN

            res := less(v, v2, error);

            IF error = 0 THEN

                res := equal(v, v2, error) OR res

            END

        ELSE

            res := less(v, v2, error)

        END

    |">":

        IF operator[1] = "=" THEN

            res := ~less(v, v2, error)

        ELSE

            res := less(v, v2, error);

            IF error = 0 THEN

                res := equal(v, v2, error) OR res

            END;

            res := ~res

        END

    |"I":

        IF (v.typ = tINTEGER) & (v2.typ = tSET) THEN

            IF range(v, 0, MACHINE.target.maxSet) THEN

                res := v.int IN v2.set

            ELSE

                error := 2

            END

        ELSE

            error := 1

        END

    END;

    IF error = 0 THEN

        v.bool := res;

        v.typ  := tBOOLEAN

    END

END relation;

PROCEDURE emptySet* (VAR v: VALUE);

BEGIN

    v.typ := tSET;

    v.set := {}

END emptySet;

PROCEDURE constrSet* (VAR v: VALUE; a, b: VALUE);

BEGIN

    v.typ := tSET;

    v.set := {a.int .. b.int}

END constrSet;

PROCEDURE getInt* (v: VALUE): INTEGER;

BEGIN

    ASSERT(check(v))

    RETURN v.int

END getInt;

PROCEDURE setInt* (VAR v: VALUE; i: INTEGER): BOOLEAN;

BEGIN

    v.int := i;

    v.typ := tINTEGER

    RETURN check(v)

END setInt;

PROCEDURE init;

VAR

    i: INTEGER;

BEGIN

    FOR i := 0 TO LEN(digit) - 1 DO

        digit[i] := -1

    END;

    FOR i := ORD("0") TO ORD("9") DO

        digit[i] := i - ORD("0")

    END;

    FOR i := ORD("A") TO ORD("F") DO

        digit[i] := i - ORD("A") + 10

    END

END init;

BEGIN

    init

END ARITH.