Subversion Repositories Kolibri OS

(*

    BSD 2-Clause License

    Copyright (c) 2018-2021, Anton Krotov

    All rights reserved.

*)

MODULE ARITH;

IMPORT STRINGS, UTILS, LISTS;

CONST

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

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

    tSTRING*  = 7;

    opEQ* = 0; opNE* = 1; opLT* = 2; opLE* = 3; opGT* = 4; opGE* = 5;

    opIN* = 6; opIS* = 7;

TYPE

    VALUE* = RECORD

        typ*:      INTEGER;

        int:       INTEGER;

        float:     REAL;

        set:       SET;

        bool:      BOOLEAN;

        string*:   LISTS.ITEM

    END;

VAR

    digit: ARRAY 256 OF INTEGER;

PROCEDURE Int* (v: VALUE): INTEGER;

VAR

    res: INTEGER;

BEGIN

    CASE v.typ OF

    |tINTEGER, tCHAR, tWCHAR:

        res := v.int

    |tSET:

        res := UTILS.Long(ORD(v.set))

    |tBOOLEAN:

        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 range* (i: VALUE; a, b: INTEGER): BOOLEAN;

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

END range;

PROCEDURE check* (v: VALUE): BOOLEAN;

VAR

    res: BOOLEAN;

BEGIN

    CASE v.typ OF

    |tINTEGER: res := range(v, UTILS.target.minInt, UTILS.target.maxInt)

    |tCHAR:    res := range(v, 0, 255)

    |tWCHAR:   res := range(v, 0, 65535)

    |tREAL:    res := (-UTILS.target.maxReal <= v.float) & (v.float <= UTILS.target.maxReal)

    END

    RETURN res

END check;

PROCEDURE isZero* (v: VALUE): BOOLEAN;

VAR

    res: BOOLEAN;

BEGIN

    CASE v.typ OF

    |tINTEGER: res := v.int = 0

    |tREAL:    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") & (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 > UTILS.target.maxHex) THEN

            error := 2

        ELSE

            value := value * 16 + d;

            INC(i)

        END

    END;

    value := UTILS.Long(value);

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

        error := 3

    END;

    IF error = 0 THEN

        v.int := value;

        IF (s[i] = "X") OR (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;

BEGIN

    CASE op OF

    |"+": a := a + b

    |"-": a := a - b

    |"*": a := a * b

    |"/": a := a / b

    END

    RETURN (-UTILS.maxreal <= a) & (a <= UTILS.maxreal) (* +inf > UTILS.maxreal *)

END opFloat2;

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

VAR

    value:    REAL;

    frac:     REAL;

    exp10:    REAL;

    i, n, d:  INTEGER;

    minus:    BOOLEAN;

BEGIN

    error := 0;

    value := 0.0;

    frac  := 0.0;

    exp10 := 1.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(frac, 10.0, "*") & opFloat2(frac, FLT(digit[ORD(s[i])]), "+") THEN

            exp10 := exp10 * 10.0;

            INC(i)

        ELSE

            error := 4

        END

    END;

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

        error := 4

    END;

    IF (s[i] = "E") OR (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 := UTILS.Log2(x);

    IF n = -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;

    RETURN ASR(UTILS.Long(x), n)

END _ASR;

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

    RETURN UTILS.Long(LSR(UTILS.Short(x), n))

END _LSR;

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

    RETURN UTILS.Long(LSL(x, n))

END _LSL;

PROCEDURE _ROR1_32 (x: INTEGER): INTEGER;

BEGIN

    x := UTILS.Short(x);

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

    RETURN UTILS.Long(x)

END _ROR1_32;

PROCEDURE _ROR1_16 (x: INTEGER): INTEGER;

BEGIN

    x := x MOD 65536;

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

    RETURN UTILS.Long(x)

END _ROR1_16;

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

BEGIN

    CASE UTILS.bit_diff OF

    |0: x := ROR(x, n)

    |16, 48:

        n := n MOD 16;

        WHILE n > 0 DO

            x := _ROR1_16(x);

            DEC(n)

        END

    |32:

        n := n MOD 32;

        WHILE n > 0 DO

            x := _ROR1_32(x);

            DEC(n)

        END

    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": a.int := a.int DIV b.int

    |"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 := UTILS.Long(ORD(v.set))

    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 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; op: INTEGER; VAR error: INTEGER);

VAR

    res: BOOLEAN;

BEGIN

    error := 0;

    res := FALSE;

    CASE op OF

    |opEQ:

        res := equal(v, v2, error)

    |opNE:

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

    |opLT:

        res := less(v, v2, error)

    |opLE:

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

        IF error = 0 THEN

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

        END

    |opGE:

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

    |opGT:

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

        IF error = 0 THEN

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

        END;

        res := ~res

    |opIN:

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

            IF range(v, 0, UTILS.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 concat* (VAR s: ARRAY OF CHAR; s1: ARRAY OF CHAR): BOOLEAN;

VAR

    res: BOOLEAN;

BEGIN

    res := LENGTH(s) + LENGTH(s1) < LEN(s);

    IF res THEN

        STRINGS.append(s, s1)

    END

    RETURN res

END concat;

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.