82d72daa76
git-svn-id: svn://kolibrios.org@7597 a494cfbc-eb01-0410-851d-a64ba20cac60
861 lines
16 KiB
Plaintext
861 lines
16 KiB
Plaintext
(*
|
|
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. |