WebSVN – Kolibri OS – Diff – /programs/develop/oberon07/Source/ARITH.ob07


﻿(*
    BSD 2-Clause License
 
    Copyright (c) 2018-2020, Anton Krotov
    All rights reserved.
*)
 
MODULE ARITH;
 
IMPORT AVLTREES, STRINGS, UTILS;
 
 
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*:   AVLTREES.DATA
 
    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") & (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") & (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;
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;
    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 := 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.
 

Rev 7983	Rev 8097
1	(*	1	(*
2	BSD 2-Clause License	2	BSD 2-Clause License
3		3
4	Copyright (c) 2018-2020, Anton Krotov	4	Copyright (c) 2018-2020, Anton Krotov
5	All rights reserved.	5	All rights reserved.
6	*)	6	*)
7		7
8	MODULE ARITH;	8	MODULE ARITH;
9		9
10	IMPORT AVLTREES, STRINGS, UTILS;	10	IMPORT AVLTREES, STRINGS, UTILS;
11		11
12		12
13	CONST	13	CONST
14		14
15	tINTEGER* = 1; tREAL* = 2; tSET* = 3;	15	tINTEGER* = 1; tREAL* = 2; tSET* = 3;
16	tBOOLEAN* = 4; tCHAR* = 5; tWCHAR* = 6;	16	tBOOLEAN* = 4; tCHAR* = 5; tWCHAR* = 6;
17	tSTRING* = 7;	17	tSTRING* = 7;
-		18
-		19	opEQ* = 0; opNE* = 1; opLT* = 2; opLE* = 3; opGT* = 4; opGE* = 5;
18		-
19		20	opIN* = 6; opIS* = 7;
20	TYPE	21
21		22
22	RELATION* = ARRAY 3 OF CHAR;	23	TYPE
23		24
24	VALUE* = RECORD	25	VALUE* = RECORD
25		26
26	typ*: INTEGER;	27	typ*: INTEGER;
27		28
28	int: INTEGER;	29	int: INTEGER;
29	float: REAL;	30	float: REAL;
30	set: SET;	31	set: SET;
31	bool: BOOLEAN;	32	bool: BOOLEAN;
32		33
33	string*: AVLTREES.DATA	34	string*: AVLTREES.DATA
34		35
35	END;	36	END;
36		37
37		38
38	VAR	39	VAR
39		40
40	digit: ARRAY 256 OF INTEGER;	41	digit: ARRAY 256 OF INTEGER;
41		42
42		43
43	PROCEDURE Int* (v: VALUE): INTEGER;	44	PROCEDURE Int* (v: VALUE): INTEGER;
44	VAR	45	VAR
45	res: INTEGER;	46	res: INTEGER;
46		47
47	BEGIN	48	BEGIN
48		49
49	CASE v.typ OF	50	CASE v.typ OF
50	\|tINTEGER, tCHAR, tWCHAR:	51	\|tINTEGER, tCHAR, tWCHAR:
51	res := v.int	52	res := v.int
52	\|tSET:	53	\|tSET:
53	res := UTILS.Long(ORD(v.set))	54	res := UTILS.Long(ORD(v.set))
54	\|tBOOLEAN:	55	\|tBOOLEAN:
55	res := ORD(v.bool)	56	res := ORD(v.bool)
56	END	57	END
57		58
58	RETURN res	59	RETURN res
59	END Int;	60	END Int;
60		61
61		62
62	PROCEDURE getBool* (v: VALUE): BOOLEAN;	63	PROCEDURE getBool* (v: VALUE): BOOLEAN;
63	BEGIN	64	BEGIN
64	ASSERT(v.typ = tBOOLEAN);	65	ASSERT(v.typ = tBOOLEAN);
65		66
66	RETURN v.bool	67	RETURN v.bool
67	END getBool;	68	END getBool;
68		69
69		70
70	PROCEDURE Float* (v: VALUE): REAL;	71	PROCEDURE Float* (v: VALUE): REAL;
71	BEGIN	72	BEGIN
72	ASSERT(v.typ = tREAL);	73	ASSERT(v.typ = tREAL);
73		74
74	RETURN v.float	75	RETURN v.float
75	END Float;	76	END Float;
76		77
77		78
78	PROCEDURE range* (i: VALUE; a, b: INTEGER): BOOLEAN;	79	PROCEDURE range* (i: VALUE; a, b: INTEGER): BOOLEAN;
79	RETURN (a <= i.int) & (i.int <= b)	80	RETURN (a <= i.int) & (i.int <= b)
80	END range;	81	END range;
81		82
82		83
83	PROCEDURE check* (v: VALUE): BOOLEAN;	84	PROCEDURE check* (v: VALUE): BOOLEAN;
84	VAR	85	VAR
85	res: BOOLEAN;	86	res: BOOLEAN;
86		87
87	BEGIN	88	BEGIN
88	CASE v.typ OF	89	CASE v.typ OF
89	\|tINTEGER: res := range(v, UTILS.target.minInt, UTILS.target.maxInt)	90	\|tINTEGER: res := range(v, UTILS.target.minInt, UTILS.target.maxInt)
90	\|tCHAR: res := range(v, 0, 255)	91	\|tCHAR: res := range(v, 0, 255)
91	\|tWCHAR: res := range(v, 0, 65535)	92	\|tWCHAR: res := range(v, 0, 65535)
92	\|tREAL: res := (-UTILS.target.maxReal <= v.float) & (v.float <= UTILS.target.maxReal)	93	\|tREAL: res := (-UTILS.target.maxReal <= v.float) & (v.float <= UTILS.target.maxReal)
93	END	94	END
94		95
95	RETURN res	96	RETURN res
96	END check;	97	END check;
97		98
98		99
99	PROCEDURE isZero* (v: VALUE): BOOLEAN;	100	PROCEDURE isZero* (v: VALUE): BOOLEAN;
100	VAR	101	VAR
101	res: BOOLEAN;	102	res: BOOLEAN;
102		103
103	BEGIN	104	BEGIN
104	CASE v.typ OF	105	CASE v.typ OF
105	\|tINTEGER: res := v.int = 0	106	\|tINTEGER: res := v.int = 0
106	\|tREAL: res := v.float = 0.0	107	\|tREAL: res := v.float = 0.0
107	END	108	END
108		109
109	RETURN res	110	RETURN res
110	END isZero;	111	END isZero;
111		112
112		113
113	PROCEDURE iconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);	114	PROCEDURE iconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);
114	VAR	115	VAR
115	value: INTEGER;	116	value: INTEGER;
116	i: INTEGER;	117	i: INTEGER;
117	d: INTEGER;	118	d: INTEGER;
118		119
119	BEGIN	120	BEGIN
120	error := 0;	121	error := 0;
121	value := 0;	122	value := 0;
122		123
123	i := 0;	124	i := 0;
124	WHILE STRINGS.digit(s[i]) & (error = 0) DO	125	WHILE STRINGS.digit(s[i]) & (error = 0) DO
125	d := digit[ORD(s[i])];	126	d := digit[ORD(s[i])];
126	IF value <= (UTILS.maxint - d) DIV 10 THEN	127	IF value <= (UTILS.maxint - d) DIV 10 THEN
127	value := value * 10 + d;	128	value := value * 10 + d;
128	INC(i)	129	INC(i)
129	ELSE	130	ELSE
130	error := 1	131	error := 1
131	END	132	END
132	END;	133	END;
133		134
134	IF error = 0 THEN	135	IF error = 0 THEN
135	v.int := value;	136	v.int := value;
136	v.typ := tINTEGER;	137	v.typ := tINTEGER;
137	IF ~check(v) THEN	138	IF ~check(v) THEN
138	error := 1	139	error := 1
139	END	140	END
140	END	141	END
141		142
142	END iconv;	143	END iconv;
143		144
144		145
145	PROCEDURE hconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);	146	PROCEDURE hconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);
146	VAR	147	VAR
147	value: INTEGER;	148	value: INTEGER;
148	i: INTEGER;	149	i: INTEGER;
149	n: INTEGER;	150	n: INTEGER;
150	d: INTEGER;	151	d: INTEGER;
151		152
152	BEGIN	153	BEGIN
153	ASSERT(STRINGS.digit(s[0]));	154	ASSERT(STRINGS.digit(s[0]));
154		155
155	error := 0;	156	error := 0;
156	value := 0;	157	value := 0;
157		158
158	n := -1;	159	n := -1;
159	i := 0;	160	i := 0;
160	WHILE (s[i] # "H") & (s[i] # "X") & (error = 0) DO	161	WHILE (s[i] # "H") & (s[i] # "X") & (error = 0) DO
161		162
162	d := digit[ORD(s[i])];	163	d := digit[ORD(s[i])];
163	IF (n = -1) & (d # 0) THEN	164	IF (n = -1) & (d # 0) THEN
164	n := i	165	n := i
165	END;	166	END;
166		167
167	IF (n # -1) & (i - n + 1 > UTILS.target.maxHex) THEN	168	IF (n # -1) & (i - n + 1 > UTILS.target.maxHex) THEN
168	error := 2	169	error := 2
169	ELSE	170	ELSE
170	value := value * 16 + d;	171	value := value * 16 + d;
171	INC(i)	172	INC(i)
172	END	173	END
173		174
174	END;	175	END;
175		176
176	value := UTILS.Long(value);	177	value := UTILS.Long(value);
177		178
178	IF (s[i] = "X") & (n # -1) & (i - n > 4) THEN	179	IF (s[i] = "X") & (n # -1) & (i - n > 4) THEN
179	error := 3	180	error := 3
180	END;	181	END;
181		182
182	IF error = 0 THEN	183	IF error = 0 THEN
183	v.int := value;	184	v.int := value;
184	IF s[i] = "X" THEN	185	IF s[i] = "X" THEN
185	v.typ := tCHAR;	186	v.typ := tCHAR;
186	IF ~check(v) THEN	187	IF ~check(v) THEN
187	v.typ := tWCHAR;	188	v.typ := tWCHAR;
188	IF ~check(v) THEN	189	IF ~check(v) THEN
189	error := 3	190	error := 3
190	END	191	END
191	END	192	END
192	ELSE	193	ELSE
193	v.typ := tINTEGER;	194	v.typ := tINTEGER;
194	IF ~check(v) THEN	195	IF ~check(v) THEN
195	error := 2	196	error := 2
196	END	197	END
197	END	198	END
198	END	199	END
199		200
200	END hconv;	201	END hconv;
201		202
202		203
203	PROCEDURE opFloat2 (VAR a: REAL; b: REAL; op: CHAR): BOOLEAN;	204	PROCEDURE opFloat2 (VAR a: REAL; b: REAL; op: CHAR): BOOLEAN;
204	BEGIN	205	BEGIN
205	CASE op OF	206	CASE op OF
206	\|"+": a := a + b	207	\|"+": a := a + b
207	\|"-": a := a - b	208	\|"-": a := a - b
208	\|"": a := a b	209	\|"": a := a b
209	\|"/": a := a / b	210	\|"/": a := a / b
210	END	211	END
211		212
212	RETURN (-UTILS.maxreal <= a) & (a <= UTILS.maxreal) (* +inf > UTILS.maxreal *)	213	RETURN (-UTILS.maxreal <= a) & (a <= UTILS.maxreal) (* +inf > UTILS.maxreal *)
213	END opFloat2;	214	END opFloat2;
214		215
215		216
216	PROCEDURE fconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);	217	PROCEDURE fconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER);
217	VAR	218	VAR
218	value: REAL;	219	value: REAL;
219	exp10: REAL;	220	exp10: REAL;
220	i, n, d: INTEGER;	221	i, n, d: INTEGER;
221	minus: BOOLEAN;	222	minus: BOOLEAN;
222		223
223	BEGIN	224	BEGIN
224	error := 0;	225	error := 0;
225	value := 0.0;	226	value := 0.0;
226	exp10 := 10.0;	227	exp10 := 10.0;
227	minus := FALSE;	228	minus := FALSE;
228	n := 0;	229	n := 0;
229		230
230	i := 0;	231	i := 0;
231	WHILE (error = 0) & STRINGS.digit(s[i]) DO	232	WHILE (error = 0) & STRINGS.digit(s[i]) DO
232	IF opFloat2(value, 10.0, "*") & opFloat2(value, FLT(digit[ORD(s[i])]), "+") THEN	233	IF opFloat2(value, 10.0, "*") & opFloat2(value, FLT(digit[ORD(s[i])]), "+") THEN
233	INC(i)	234	INC(i)
234	ELSE	235	ELSE
235	error := 4	236	error := 4
236	END	237	END
237	END;	238	END;
238		239
239	INC(i);	240	INC(i);
240		241
241	WHILE (error = 0) & STRINGS.digit(s[i]) DO	242	WHILE (error = 0) & STRINGS.digit(s[i]) DO
242	IF opFloat2(value, FLT(digit[ORD(s[i])]) / exp10, "+") & opFloat2(exp10, 10.0, "*") THEN	243	IF opFloat2(value, FLT(digit[ORD(s[i])]) / exp10, "+") & opFloat2(exp10, 10.0, "*") THEN
243	INC(i)	244	INC(i)
244	ELSE	245	ELSE
245	error := 4	246	error := 4
246	END	247	END
247	END;	248	END;
248		249
249	IF s[i] = "E" THEN	250	IF s[i] = "E" THEN
250	INC(i)	251	INC(i)
251	END;	252	END;
252		253
253	IF (s[i] = "-") OR (s[i] = "+") THEN	254	IF (s[i] = "-") OR (s[i] = "+") THEN
254	minus := s[i] = "-";	255	minus := s[i] = "-";
255	INC(i)	256	INC(i)
256	END;	257	END;
257		258
258	WHILE (error = 0) & STRINGS.digit(s[i]) DO	259	WHILE (error = 0) & STRINGS.digit(s[i]) DO
259	d := digit[ORD(s[i])];	260	d := digit[ORD(s[i])];
260	IF n <= (UTILS.maxint - d) DIV 10 THEN	261	IF n <= (UTILS.maxint - d) DIV 10 THEN
261	n := n * 10 + d;	262	n := n * 10 + d;
262	INC(i)	263	INC(i)
263	ELSE	264	ELSE
264	error := 5	265	error := 5
265	END	266	END
266	END;	267	END;
267		268
268	exp10 := 1.0;	269	exp10 := 1.0;
269	WHILE (error = 0) & (n > 0) DO	270	WHILE (error = 0) & (n > 0) DO
270	IF opFloat2(exp10, 10.0, "*") THEN	271	IF opFloat2(exp10, 10.0, "*") THEN
271	DEC(n)	272	DEC(n)
272	ELSE	273	ELSE
273	error := 4	274	error := 4
274	END	275	END
275	END;	276	END;
276		277
277	IF error = 0 THEN	278	IF error = 0 THEN
278	IF minus THEN	279	IF minus THEN
279	IF ~opFloat2(value, exp10, "/") THEN	280	IF ~opFloat2(value, exp10, "/") THEN
280	error := 4	281	error := 4
281	END	282	END
282	ELSE	283	ELSE
283	IF ~opFloat2(value, exp10, "*") THEN	284	IF ~opFloat2(value, exp10, "*") THEN
284	error := 4	285	error := 4
285	END	286	END
286	END	287	END
287	END;	288	END;
288		289
289	IF error = 0 THEN	290	IF error = 0 THEN
290	v.float := value;	291	v.float := value;
291	v.typ := tREAL;	292	v.typ := tREAL;
292	IF ~check(v) THEN	293	IF ~check(v) THEN
293	error := 4	294	error := 4
294	END	295	END
295	END	296	END
296		297
297	END fconv;	298	END fconv;
298		299
299		300
300	PROCEDURE setChar* (VAR v: VALUE; ord: INTEGER);	301	PROCEDURE setChar* (VAR v: VALUE; ord: INTEGER);
301	BEGIN	302	BEGIN
302	v.typ := tCHAR;	303	v.typ := tCHAR;
303	v.int := ord	304	v.int := ord
304	END setChar;	305	END setChar;
305		306
306		307
307	PROCEDURE setWChar* (VAR v: VALUE; ord: INTEGER);	308	PROCEDURE setWChar* (VAR v: VALUE; ord: INTEGER);
308	BEGIN	309	BEGIN
309	v.typ := tWCHAR;	310	v.typ := tWCHAR;
310	v.int := ord	311	v.int := ord
311	END setWChar;	312	END setWChar;
312		313
313		314
314	PROCEDURE addInt (VAR a: INTEGER; b: INTEGER): BOOLEAN;	315	PROCEDURE addInt (VAR a: INTEGER; b: INTEGER): BOOLEAN;
315	VAR	316	VAR
316	error: BOOLEAN;	317	error: BOOLEAN;
317		318
318	BEGIN	319	BEGIN
319	IF (a > 0) & (b > 0) THEN	320	IF (a > 0) & (b > 0) THEN
320	error := a > UTILS.maxint - b	321	error := a > UTILS.maxint - b
321	ELSIF (a < 0) & (b < 0) THEN	322	ELSIF (a < 0) & (b < 0) THEN
322	error := a < UTILS.minint - b	323	error := a < UTILS.minint - b
323	ELSE	324	ELSE
324	error := FALSE	325	error := FALSE
325	END;	326	END;
326		327
327	IF ~error THEN	328	IF ~error THEN
328	a := a + b	329	a := a + b
329	ELSE	330	ELSE
330	a := 0	331	a := 0
331	END	332	END
332		333
333	RETURN ~error	334	RETURN ~error
334	END addInt;	335	END addInt;
335		336
336		337
337	PROCEDURE subInt (VAR a: INTEGER; b: INTEGER): BOOLEAN;	338	PROCEDURE subInt (VAR a: INTEGER; b: INTEGER): BOOLEAN;
338	VAR	339	VAR
339	error: BOOLEAN;	340	error: BOOLEAN;
340		341
341	BEGIN	342	BEGIN
342	IF (a > 0) & (b < 0) THEN	343	IF (a > 0) & (b < 0) THEN
343	error := a > UTILS.maxint + b	344	error := a > UTILS.maxint + b
344	ELSIF (a < 0) & (b > 0) THEN	345	ELSIF (a < 0) & (b > 0) THEN
345	error := a < UTILS.minint + b	346	error := a < UTILS.minint + b
346	ELSIF (a = 0) & (b < 0) THEN	347	ELSIF (a = 0) & (b < 0) THEN
347	error := b = UTILS.minint	348	error := b = UTILS.minint
348	ELSE	349	ELSE
349	error := FALSE	350	error := FALSE
350	END;	351	END;
351		352
352	IF ~error THEN	353	IF ~error THEN
353	a := a - b	354	a := a - b
354	ELSE	355	ELSE
355	a := 0	356	a := 0
356	END	357	END
357		358
358	RETURN ~error	359	RETURN ~error
359	END subInt;	360	END subInt;
360		361
361		362
362	PROCEDURE lg2 (x: INTEGER): INTEGER;	363	PROCEDURE lg2 (x: INTEGER): INTEGER;
363	VAR	364	VAR
364	n: INTEGER;	365	n: INTEGER;
365		366
366	BEGIN	367	BEGIN
367	ASSERT(x > 0);	368	ASSERT(x > 0);
368		369
369	n := UTILS.Log2(x);	370	n := UTILS.Log2(x);
370	IF n = -1 THEN	371	IF n = -1 THEN
371	n := 255	372	n := 255
372	END	373	END
373		374
374	RETURN n	375	RETURN n
375	END lg2;	376	END lg2;
376		377
377		378
378	PROCEDURE mulInt* (VAR a: INTEGER; b: INTEGER): BOOLEAN;	379	PROCEDURE mulInt* (VAR a: INTEGER; b: INTEGER): BOOLEAN;
379	VAR	380	VAR
380	error: BOOLEAN;	381	error: BOOLEAN;
381	min, max: INTEGER;	382	min, max: INTEGER;
382		383
383	BEGIN	384	BEGIN
384	min := UTILS.minint;	385	min := UTILS.minint;
385	max := UTILS.maxint;	386	max := UTILS.maxint;
386		387
387	IF ((a > 1) & (b > 1)) OR ((a < 0) & (b < 0)) THEN	388	IF ((a > 1) & (b > 1)) OR ((a < 0) & (b < 0)) THEN
388	error := (a = min) OR (b = min) OR (ABS(a) > max DIV ABS(b))	389	error := (a = min) OR (b = min) OR (ABS(a) > max DIV ABS(b))
389		390
390	ELSIF ((a > 1) & (b < 0)) OR ((a < 0) & (b > 1)) THEN	391	ELSIF ((a > 1) & (b < 0)) OR ((a < 0) & (b > 1)) THEN
391	error := (a = min) OR (b = min);	392	error := (a = min) OR (b = min);
392	IF ~error THEN	393	IF ~error THEN
393	IF lg2(ABS(a)) + lg2(ABS(b)) >= UTILS.bit_depth THEN	394	IF lg2(ABS(a)) + lg2(ABS(b)) >= UTILS.bit_depth THEN
394	error := ABS(a) > max DIV ABS(b)	395	error := ABS(a) > max DIV ABS(b)
395	END	396	END
396	END	397	END
397		398
398	ELSE	399	ELSE
399	error := FALSE	400	error := FALSE
400	END;	401	END;
401		402
402	IF ~error THEN	403	IF ~error THEN
403	a := a * b	404	a := a * b
404	ELSE	405	ELSE
405	a := 0	406	a := 0
406	END	407	END
407		408
408	RETURN ~error	409	RETURN ~error
409	END mulInt;	410	END mulInt;
410		411
411		412
412	PROCEDURE _ASR (x, n: INTEGER): INTEGER;	413	PROCEDURE _ASR (x, n: INTEGER): INTEGER;
413	RETURN ASR(UTILS.Long(x), n)	414	RETURN ASR(UTILS.Long(x), n)
414	END _ASR;	415	END _ASR;
415		416
416		417
417	PROCEDURE _LSR (x, n: INTEGER): INTEGER;	418	PROCEDURE _LSR (x, n: INTEGER): INTEGER;
418	RETURN UTILS.Long(LSR(UTILS.Short(x), n))	419	RETURN UTILS.Long(LSR(UTILS.Short(x), n))
419	END _LSR;	420	END _LSR;
420		421
421		422
422	PROCEDURE _LSL (x, n: INTEGER): INTEGER;	423	PROCEDURE _LSL (x, n: INTEGER): INTEGER;
423	RETURN UTILS.Long(LSL(x, n))	424	RETURN UTILS.Long(LSL(x, n))
424	END _LSL;	425	END _LSL;
425		426
426		427
427	PROCEDURE _ROR1_32 (x: INTEGER): INTEGER;	428	PROCEDURE _ROR1_32 (x: INTEGER): INTEGER;
428	BEGIN	429	BEGIN
429	x := UTILS.Short(x);	430	x := UTILS.Short(x);
430	x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 31)))	431	x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 31)))
431	RETURN UTILS.Long(x)	432	RETURN UTILS.Long(x)
432	END _ROR1_32;	433	END _ROR1_32;
433		434
434		435
435	PROCEDURE _ROR1_16 (x: INTEGER): INTEGER;	436	PROCEDURE _ROR1_16 (x: INTEGER): INTEGER;
436	BEGIN	437	BEGIN
437	x := x MOD 65536;	438	x := x MOD 65536;
438	x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 15)))	439	x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 15)))
439	RETURN UTILS.Long(x)	440	RETURN UTILS.Long(x)
440	END _ROR1_16;	441	END _ROR1_16;
441		442
442		443
443	PROCEDURE _ROR (x, n: INTEGER): INTEGER;	444	PROCEDURE _ROR (x, n: INTEGER): INTEGER;
444	BEGIN	445	BEGIN
445		446
446	CASE UTILS.bit_diff OF	447	CASE UTILS.bit_diff OF
447	\|0: x := ROR(x, n)	448	\|0: x := ROR(x, n)
448	\|16, 48:	449	\|16, 48:
449	n := n MOD 16;	450	n := n MOD 16;
450	WHILE n > 0 DO	451	WHILE n > 0 DO
451	x := _ROR1_16(x);	452	x := _ROR1_16(x);
452	DEC(n)	453	DEC(n)
453	END	454	END
454	\|32:	455	\|32:
455	n := n MOD 32;	456	n := n MOD 32;
456	WHILE n > 0 DO	457	WHILE n > 0 DO
457	x := _ROR1_32(x);	458	x := _ROR1_32(x);
458	DEC(n)	459	DEC(n)
459	END	460	END
460	END	461	END
461		462
462	RETURN x	463	RETURN x
463	END _ROR;	464	END _ROR;
464		465
465		466
466	PROCEDURE opInt* (VAR a: VALUE; b: VALUE; op: CHAR): BOOLEAN;	467	PROCEDURE opInt* (VAR a: VALUE; b: VALUE; op: CHAR): BOOLEAN;
467	VAR	468	VAR
468	success: BOOLEAN;	469	success: BOOLEAN;
469		470
470	BEGIN	471	BEGIN
471	success := TRUE;	472	success := TRUE;
472		473
473	CASE op OF	474	CASE op OF
474	\|"+": success := addInt(a.int, b.int)	475	\|"+": success := addInt(a.int, b.int)
475	\|"-": success := subInt(a.int, b.int)	476	\|"-": success := subInt(a.int, b.int)
476	\|"*": success := mulInt(a.int, b.int)	477	\|"*": success := mulInt(a.int, b.int)
477	\|"/": success := FALSE	478	\|"/": success := FALSE
478	\|"D": a.int := a.int DIV b.int	479	\|"D": a.int := a.int DIV b.int
479	\|"M": a.int := a.int MOD b.int	480	\|"M": a.int := a.int MOD b.int
480	\|"L": a.int := _LSL(a.int, b.int)	481	\|"L": a.int := _LSL(a.int, b.int)
481	\|"A": a.int := _ASR(a.int, b.int)	482	\|"A": a.int := _ASR(a.int, b.int)
482	\|"O": a.int := _ROR(a.int, b.int)	483	\|"O": a.int := _ROR(a.int, b.int)
483	\|"R": a.int := _LSR(a.int, b.int)	484	\|"R": a.int := _LSR(a.int, b.int)
484	\|"m": a.int := MIN(a.int, b.int)	485	\|"m": a.int := MIN(a.int, b.int)
485	\|"x": a.int := MAX(a.int, b.int)	486	\|"x": a.int := MAX(a.int, b.int)
486	END;	487	END;
487	a.typ := tINTEGER	488	a.typ := tINTEGER
488		489
489	RETURN success & check(a)	490	RETURN success & check(a)
490	END opInt;	491	END opInt;
491		492
492		493
493	PROCEDURE charToStr* (c: VALUE; VAR s: ARRAY OF CHAR);	494	PROCEDURE charToStr* (c: VALUE; VAR s: ARRAY OF CHAR);
494	BEGIN	495	BEGIN
495	s[0] := CHR(c.int);	496	s[0] := CHR(c.int);
496	s[1] := 0X	497	s[1] := 0X
497	END charToStr;	498	END charToStr;
498		499

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Source/ARITH.ob07 – Rev 7983 → 8097