| 0,0 → 1,861 |
|---|
| (* |
| 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. |