mirror of
https://github.com/AntKrotov/oberon-07-compiler.git
synced 2026-10-05 09:45:47 +00:00
Экспериментально добавлена трансляция в байт-код 32-битной виртуальной машины
This commit is contained in:
AntKrotov committed
1 parent
61e288d9e5
commit
8a49dad5f9
20 files changed
+3452
-222
No files matched your search
Binary file not shown.
+17
-30
@@ -372,33 +372,29 @@ END PCharToStr;
|
||||
|
||||
PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, a, b: INTEGER;
|
||||
c: CHAR;
|
||||
i, a: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := 0;
|
||||
a := x;
|
||||
REPEAT
|
||||
str[i] := CHR(x MOD 10 + ORD("0"));
|
||||
x := x DIV 10;
|
||||
INC(i)
|
||||
UNTIL x = 0;
|
||||
INC(i);
|
||||
a := a DIV 10
|
||||
UNTIL a = 0;
|
||||
|
||||
a := 0;
|
||||
b := i - 1;
|
||||
WHILE a < b DO
|
||||
c := str[a];
|
||||
str[a] := str[b];
|
||||
str[b] := c;
|
||||
INC(a);
|
||||
DEC(b)
|
||||
END;
|
||||
str[i] := 0X
|
||||
str[i] := 0X;
|
||||
|
||||
REPEAT
|
||||
DEC(i);
|
||||
str[i] := CHR(x MOD 10 + ORD("0"));
|
||||
x := x DIV 10
|
||||
UNTIL x = 0
|
||||
END IntToStr;
|
||||
|
||||
|
||||
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
|
||||
VAR
|
||||
n1, n2, i, j: INTEGER;
|
||||
n1, n2: INTEGER;
|
||||
|
||||
BEGIN
|
||||
n1 := LENGTH(s1);
|
||||
@@ -406,15 +402,8 @@ BEGIN
|
||||
|
||||
ASSERT(n1 + n2 < LEN(s1));
|
||||
|
||||
i := 0;
|
||||
j := n1;
|
||||
WHILE i < n2 DO
|
||||
s1[j] := s2[i];
|
||||
INC(i);
|
||||
INC(j)
|
||||
END;
|
||||
|
||||
s1[j] := 0X
|
||||
SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
|
||||
s1[n1 + n2] := 0X
|
||||
END append;
|
||||
|
||||
|
||||
@@ -437,10 +426,8 @@ BEGIN
|
||||
|11: s := "BYTE out of range"
|
||||
END;
|
||||
|
||||
append(s, API.eol);
|
||||
|
||||
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
|
||||
append(s, "line: "); IntToStr(line, temp); append(s, temp);
|
||||
append(s, API.eol + "module: "); PCharToStr(module, temp); append(s, temp);
|
||||
append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
|
||||
|
||||
API.DebugMsg(SYSTEM.ADR(s[0]), name);
|
||||
|
||||
|
||||
+17
-30
@@ -372,33 +372,29 @@ END PCharToStr;
|
||||
|
||||
PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, a, b: INTEGER;
|
||||
c: CHAR;
|
||||
i, a: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := 0;
|
||||
a := x;
|
||||
REPEAT
|
||||
str[i] := CHR(x MOD 10 + ORD("0"));
|
||||
x := x DIV 10;
|
||||
INC(i)
|
||||
UNTIL x = 0;
|
||||
INC(i);
|
||||
a := a DIV 10
|
||||
UNTIL a = 0;
|
||||
|
||||
a := 0;
|
||||
b := i - 1;
|
||||
WHILE a < b DO
|
||||
c := str[a];
|
||||
str[a] := str[b];
|
||||
str[b] := c;
|
||||
INC(a);
|
||||
DEC(b)
|
||||
END;
|
||||
str[i] := 0X
|
||||
str[i] := 0X;
|
||||
|
||||
REPEAT
|
||||
DEC(i);
|
||||
str[i] := CHR(x MOD 10 + ORD("0"));
|
||||
x := x DIV 10
|
||||
UNTIL x = 0
|
||||
END IntToStr;
|
||||
|
||||
|
||||
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
|
||||
VAR
|
||||
n1, n2, i, j: INTEGER;
|
||||
n1, n2: INTEGER;
|
||||
|
||||
BEGIN
|
||||
n1 := LENGTH(s1);
|
||||
@@ -406,15 +402,8 @@ BEGIN
|
||||
|
||||
ASSERT(n1 + n2 < LEN(s1));
|
||||
|
||||
i := 0;
|
||||
j := n1;
|
||||
WHILE i < n2 DO
|
||||
s1[j] := s2[i];
|
||||
INC(i);
|
||||
INC(j)
|
||||
END;
|
||||
|
||||
s1[j] := 0X
|
||||
SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
|
||||
s1[n1 + n2] := 0X
|
||||
END append;
|
||||
|
||||
|
||||
@@ -437,10 +426,8 @@ BEGIN
|
||||
|11: s := "BYTE out of range"
|
||||
END;
|
||||
|
||||
append(s, API.eol);
|
||||
|
||||
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
|
||||
append(s, "line: "); IntToStr(line, temp); append(s, temp);
|
||||
append(s, API.eol + "module: "); PCharToStr(module, temp); append(s, temp);
|
||||
append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
|
||||
|
||||
API.DebugMsg(SYSTEM.ADR(s[0]), name);
|
||||
|
||||
|
||||
+17
-30
@@ -350,33 +350,29 @@ END PCharToStr;
|
||||
|
||||
PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, a, b: INTEGER;
|
||||
c: CHAR;
|
||||
i, a: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := 0;
|
||||
a := x;
|
||||
REPEAT
|
||||
str[i] := CHR(x MOD 10 + ORD("0"));
|
||||
x := x DIV 10;
|
||||
INC(i)
|
||||
UNTIL x = 0;
|
||||
INC(i);
|
||||
a := a DIV 10
|
||||
UNTIL a = 0;
|
||||
|
||||
a := 0;
|
||||
b := i - 1;
|
||||
WHILE a < b DO
|
||||
c := str[a];
|
||||
str[a] := str[b];
|
||||
str[b] := c;
|
||||
INC(a);
|
||||
DEC(b)
|
||||
END;
|
||||
str[i] := 0X
|
||||
str[i] := 0X;
|
||||
|
||||
REPEAT
|
||||
DEC(i);
|
||||
str[i] := CHR(x MOD 10 + ORD("0"));
|
||||
x := x DIV 10
|
||||
UNTIL x = 0
|
||||
END IntToStr;
|
||||
|
||||
|
||||
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
|
||||
VAR
|
||||
n1, n2, i, j: INTEGER;
|
||||
n1, n2: INTEGER;
|
||||
|
||||
BEGIN
|
||||
n1 := LENGTH(s1);
|
||||
@@ -384,15 +380,8 @@ BEGIN
|
||||
|
||||
ASSERT(n1 + n2 < LEN(s1));
|
||||
|
||||
i := 0;
|
||||
j := n1;
|
||||
WHILE i < n2 DO
|
||||
s1[j] := s2[i];
|
||||
INC(i);
|
||||
INC(j)
|
||||
END;
|
||||
|
||||
s1[j] := 0X
|
||||
SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
|
||||
s1[n1 + n2] := 0X
|
||||
END append;
|
||||
|
||||
|
||||
@@ -415,10 +404,8 @@ BEGIN
|
||||
|11: s := "BYTE out of range"
|
||||
END;
|
||||
|
||||
append(s, API.eol);
|
||||
|
||||
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
|
||||
append(s, "line: "); IntToStr(line, temp); append(s, temp);
|
||||
append(s, API.eol + "module: "); PCharToStr(module, temp); append(s, temp);
|
||||
append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
|
||||
|
||||
API.DebugMsg(SYSTEM.ADR(s[0]), name);
|
||||
|
||||
|
||||
@@ -0,0 +1,465 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2020, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE FPU;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
INF = 07F800000H;
|
||||
NINF = 0FF800000H;
|
||||
NAN = 07FC00000H;
|
||||
|
||||
|
||||
PROCEDURE div2 (b, a: INTEGER): INTEGER;
|
||||
VAR
|
||||
n, e, r, s: INTEGER;
|
||||
|
||||
BEGIN
|
||||
s := ORD(BITS(a) / BITS(b) - {0..30});
|
||||
e := (a DIV 800000H) MOD 256 - (b DIV 800000H) MOD 256 + 127;
|
||||
|
||||
a := a MOD 800000H + 800000H;
|
||||
b := b MOD 800000H + 800000H;
|
||||
|
||||
n := 800000H;
|
||||
r := 0;
|
||||
|
||||
IF a < b THEN
|
||||
a := a * 2;
|
||||
DEC(e)
|
||||
END;
|
||||
|
||||
WHILE (a > 0) & (n > 0) DO
|
||||
IF a >= b THEN
|
||||
INC(r, n);
|
||||
DEC(a, b)
|
||||
END;
|
||||
a := a * 2;
|
||||
n := n DIV 2
|
||||
END;
|
||||
|
||||
IF e <= 0 THEN
|
||||
e := 0;
|
||||
r := 800000H;
|
||||
s := 0
|
||||
ELSIF e >= 255 THEN
|
||||
e := 255;
|
||||
r := 800000H
|
||||
END
|
||||
|
||||
RETURN (r - 800000H) + e * 800000H + s
|
||||
END div2;
|
||||
|
||||
|
||||
PROCEDURE mul2 (b, a: INTEGER): INTEGER;
|
||||
VAR
|
||||
e, r, s: INTEGER;
|
||||
|
||||
BEGIN
|
||||
s := ORD(BITS(a) / BITS(b) - {0..30});
|
||||
e := (a DIV 800000H) MOD 256 + (b DIV 800000H) MOD 256 - 127;
|
||||
|
||||
a := a MOD 800000H + 800000H;
|
||||
b := b MOD 800000H + 800000H;
|
||||
|
||||
r := a * (b MOD 256);
|
||||
b := b DIV 256;
|
||||
r := LSR(r, 8);
|
||||
|
||||
INC(r, a * (b MOD 256));
|
||||
b := b DIV 256;
|
||||
r := LSR(r, 8);
|
||||
|
||||
INC(r, a * (b MOD 256));
|
||||
r := LSR(r, 7);
|
||||
|
||||
IF r >= 1000000H THEN
|
||||
r := r DIV 2;
|
||||
INC(e)
|
||||
END;
|
||||
|
||||
IF e <= 0 THEN
|
||||
e := 0;
|
||||
r := 800000H;
|
||||
s := 0
|
||||
ELSIF e >= 255 THEN
|
||||
e := 255;
|
||||
r := 800000H
|
||||
END
|
||||
|
||||
RETURN (r - 800000H) + e * 800000H + s
|
||||
END mul2;
|
||||
|
||||
|
||||
PROCEDURE add2 (b, a: INTEGER): INTEGER;
|
||||
VAR
|
||||
ea, eb, e, d, r: INTEGER;
|
||||
|
||||
BEGIN
|
||||
ea := (a DIV 800000H) MOD 256;
|
||||
eb := (b DIV 800000H) MOD 256;
|
||||
d := ea - eb;
|
||||
|
||||
a := a MOD 800000H + 800000H;
|
||||
b := b MOD 800000H + 800000H;
|
||||
|
||||
IF d > 0 THEN
|
||||
IF d < 24 THEN
|
||||
b := LSR(b, d)
|
||||
ELSE
|
||||
b := 0
|
||||
END;
|
||||
e := ea
|
||||
ELSIF d < 0 THEN
|
||||
IF d > -24 THEN
|
||||
a := LSR(a, -d)
|
||||
ELSE
|
||||
a := 0
|
||||
END;
|
||||
e := eb
|
||||
ELSE
|
||||
e := ea
|
||||
END;
|
||||
|
||||
r := a + b;
|
||||
|
||||
IF r >= 1000000H THEN
|
||||
r := r DIV 2;
|
||||
INC(e)
|
||||
END;
|
||||
|
||||
IF e >= 255 THEN
|
||||
e := 255;
|
||||
r := 800000H
|
||||
END
|
||||
|
||||
RETURN (r - 800000H) + e * 800000H
|
||||
END add2;
|
||||
|
||||
|
||||
PROCEDURE sub2 (b, a: INTEGER): INTEGER;
|
||||
VAR
|
||||
ea, eb, e, d, r, s: INTEGER;
|
||||
|
||||
BEGIN
|
||||
ea := (a DIV 800000H) MOD 256;
|
||||
eb := (b DIV 800000H) MOD 256;
|
||||
|
||||
a := a MOD 800000H + 800000H;
|
||||
b := b MOD 800000H + 800000H;
|
||||
|
||||
d := ea - eb;
|
||||
|
||||
IF (d > 0) OR (d = 0) & (a >= b) THEN
|
||||
s := 0
|
||||
ELSE
|
||||
ea := eb;
|
||||
d := -d;
|
||||
r := a;
|
||||
a := b;
|
||||
b := r;
|
||||
s := 80000000H
|
||||
END;
|
||||
|
||||
e := ea;
|
||||
|
||||
IF d > 0 THEN
|
||||
IF d < 24 THEN
|
||||
b := LSR(b, d)
|
||||
ELSE
|
||||
b := 0
|
||||
END
|
||||
END;
|
||||
|
||||
r := a - b;
|
||||
|
||||
IF r = 0 THEN
|
||||
e := 0;
|
||||
r := 800000H;
|
||||
s := 0
|
||||
ELSE
|
||||
WHILE r < 800000H DO
|
||||
r := r * 2;
|
||||
DEC(e)
|
||||
END
|
||||
END;
|
||||
|
||||
IF e <= 0 THEN
|
||||
e := 0;
|
||||
r := 800000H;
|
||||
s := 0
|
||||
END
|
||||
|
||||
RETURN (r - 800000H) + e * 800000H + s
|
||||
END sub2;
|
||||
|
||||
|
||||
PROCEDURE zero (VAR x: INTEGER);
|
||||
BEGIN
|
||||
IF BITS(x) * {23..30} = {} THEN
|
||||
x := 0
|
||||
END
|
||||
END zero;
|
||||
|
||||
|
||||
PROCEDURE isNaN (a: INTEGER): BOOLEAN;
|
||||
RETURN (a > INF) OR (a < 0) & (a > NINF)
|
||||
END isNaN;
|
||||
|
||||
|
||||
PROCEDURE isInf (a: INTEGER): BOOLEAN;
|
||||
RETURN (a = INF) OR (a = NINF)
|
||||
END isInf;
|
||||
|
||||
|
||||
PROCEDURE isNormal (a: INTEGER): BOOLEAN;
|
||||
RETURN (BITS(a) * {23..30} # {23..30}) & (BITS(a) * {23..30} # {})
|
||||
END isNormal;
|
||||
|
||||
|
||||
PROCEDURE add* (b, a: INTEGER): INTEGER;
|
||||
VAR
|
||||
r: INTEGER;
|
||||
|
||||
BEGIN
|
||||
zero(a); zero(b);
|
||||
|
||||
IF isNormal(a) & isNormal(b) THEN
|
||||
|
||||
IF (a > 0) & (b > 0) THEN
|
||||
r := add2(b, a)
|
||||
ELSIF (a < 0) & (b < 0) THEN
|
||||
r := add2(b, a) + 80000000H
|
||||
ELSIF (a > 0) & (b < 0) THEN
|
||||
r := sub2(b, a)
|
||||
ELSIF (a < 0) & (b > 0) THEN
|
||||
r := sub2(a, b)
|
||||
END
|
||||
|
||||
ELSIF isNaN(a) OR isNaN(b) THEN
|
||||
r := NAN
|
||||
ELSIF isInf(a) & isInf(b) THEN
|
||||
IF a = b THEN
|
||||
r := a
|
||||
ELSE
|
||||
r := NAN
|
||||
END
|
||||
ELSIF isInf(a) THEN
|
||||
r := a
|
||||
ELSIF isInf(b) THEN
|
||||
r := b
|
||||
ELSIF a = 0 THEN
|
||||
r := b
|
||||
ELSIF b = 0 THEN
|
||||
r := a
|
||||
END
|
||||
|
||||
RETURN r
|
||||
END add;
|
||||
|
||||
|
||||
PROCEDURE sub* (b, a: INTEGER): INTEGER;
|
||||
VAR
|
||||
r: INTEGER;
|
||||
|
||||
BEGIN
|
||||
zero(a); zero(b);
|
||||
|
||||
IF isNormal(a) & isNormal(b) THEN
|
||||
|
||||
IF (a > 0) & (b > 0) THEN
|
||||
r := sub2(b, a)
|
||||
ELSIF (a < 0) & (b < 0) THEN
|
||||
r := sub2(a, b)
|
||||
ELSIF (a > 0) & (b < 0) THEN
|
||||
r := add2(b, a)
|
||||
ELSIF (a < 0) & (b > 0) THEN
|
||||
r := add2(b, a) + 80000000H
|
||||
END
|
||||
|
||||
ELSIF isNaN(a) OR isNaN(b) THEN
|
||||
r := NAN
|
||||
ELSIF isInf(a) & isInf(b) THEN
|
||||
IF a # b THEN
|
||||
r := a
|
||||
ELSE
|
||||
r := NAN
|
||||
END
|
||||
ELSIF isInf(a) THEN
|
||||
r := a
|
||||
ELSIF isInf(b) THEN
|
||||
r := INF + ORD(BITS(b) / {31} - {0..30})
|
||||
ELSIF (a = 0) & (b = 0) THEN
|
||||
r := 0
|
||||
ELSIF a = 0 THEN
|
||||
r := ORD(BITS(b) / {31})
|
||||
ELSIF b = 0 THEN
|
||||
r := a
|
||||
END
|
||||
|
||||
RETURN r
|
||||
END sub;
|
||||
|
||||
|
||||
PROCEDURE mul* (b, a: INTEGER): INTEGER;
|
||||
VAR
|
||||
r: INTEGER;
|
||||
|
||||
BEGIN
|
||||
zero(a); zero(b);
|
||||
|
||||
IF isNormal(a) & isNormal(b) THEN
|
||||
r := mul2(b, a)
|
||||
ELSIF isNaN(a) OR isNaN(b) THEN
|
||||
r := NAN
|
||||
ELSIF (isInf(a) & (b = 0)) OR (isInf(b) & (a = 0)) THEN
|
||||
r := NAN
|
||||
ELSIF isInf(a) OR isInf(b) THEN
|
||||
r := INF + ORD(BITS(a) / BITS(b) - {0..30})
|
||||
ELSIF (a = 0) OR (b = 0) THEN
|
||||
r := 0
|
||||
END
|
||||
|
||||
RETURN r
|
||||
END mul;
|
||||
|
||||
|
||||
PROCEDURE div* (b, a: INTEGER): INTEGER;
|
||||
VAR
|
||||
r: INTEGER;
|
||||
|
||||
BEGIN
|
||||
zero(a); zero(b);
|
||||
|
||||
IF isNormal(a) & isNormal(b) THEN
|
||||
r := div2(b, a)
|
||||
ELSIF isNaN(a) OR isNaN(b) THEN
|
||||
r := NAN
|
||||
ELSIF isInf(a) & isInf(b) THEN
|
||||
r := NAN
|
||||
ELSIF isInf(a) THEN
|
||||
r := INF + ORD(BITS(a) / BITS(b) - {0..30})
|
||||
ELSIF isInf(b) THEN
|
||||
r := 0
|
||||
ELSIF a = 0 THEN
|
||||
IF b = 0 THEN
|
||||
r := NAN
|
||||
ELSE
|
||||
r := 0
|
||||
END
|
||||
ELSIF b = 0 THEN
|
||||
IF a > 0 THEN
|
||||
r := INF
|
||||
ELSE
|
||||
r := NINF
|
||||
END
|
||||
END
|
||||
|
||||
RETURN r
|
||||
END div;
|
||||
|
||||
|
||||
PROCEDURE cmp* (op, b, a: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
zero(a); zero(b);
|
||||
|
||||
IF isNaN(a) OR isNaN(b) THEN
|
||||
res := op = 1
|
||||
ELSIF (a < 0) & (b < 0) THEN
|
||||
CASE op OF
|
||||
|0: res := a = b
|
||||
|1: res := a # b
|
||||
|2: res := a > b
|
||||
|3: res := a >= b
|
||||
|4: res := a < b
|
||||
|5: res := a <= b
|
||||
END
|
||||
ELSE
|
||||
CASE op OF
|
||||
|0: res := a = b
|
||||
|1: res := a # b
|
||||
|2: res := a < b
|
||||
|3: res := a <= b
|
||||
|4: res := a > b
|
||||
|5: res := a >= b
|
||||
END
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END cmp;
|
||||
|
||||
|
||||
PROCEDURE flt* (x: INTEGER): INTEGER;
|
||||
VAR
|
||||
n, y, r, s: INTEGER;
|
||||
|
||||
BEGIN
|
||||
IF x = 0 THEN
|
||||
s := 0;
|
||||
r := 800000H;
|
||||
n := -126
|
||||
ELSIF x = 80000000H THEN
|
||||
s := 80000000H;
|
||||
r := 800000H;
|
||||
n := 32
|
||||
ELSE
|
||||
IF x < 0 THEN
|
||||
s := 80000000H
|
||||
ELSE
|
||||
s := 0
|
||||
END;
|
||||
n := 0;
|
||||
y := ABS(x);
|
||||
r := y;
|
||||
WHILE y > 0 DO
|
||||
y := y DIV 2;
|
||||
INC(n)
|
||||
END;
|
||||
IF n > 24 THEN
|
||||
r := LSR(r, n - 24)
|
||||
ELSE
|
||||
r := LSL(r, 24 - n)
|
||||
END
|
||||
END
|
||||
|
||||
RETURN (r - 800000H) + (n + 126) * 800000H + s
|
||||
END flt;
|
||||
|
||||
|
||||
PROCEDURE floor* (x: INTEGER): INTEGER;
|
||||
VAR
|
||||
r, e: INTEGER;
|
||||
|
||||
BEGIN
|
||||
zero(x);
|
||||
|
||||
e := (x DIV 800000H) MOD 256 - 127;
|
||||
r := x MOD 800000H + 800000H;
|
||||
|
||||
IF (0 <= e) & (e <= 22) THEN
|
||||
r := LSR(r, 23 - e) + ORD((x < 0) & (LSL(r, e + 9) # 0))
|
||||
ELSIF (23 <= e) & (e <= 54) THEN
|
||||
r := LSL(r, e - 23)
|
||||
ELSIF (e < 0) & (x < 0) THEN
|
||||
r := 1
|
||||
ELSE
|
||||
r := 0
|
||||
END;
|
||||
|
||||
IF x < 0 THEN
|
||||
r := -r
|
||||
END
|
||||
|
||||
RETURN r
|
||||
END floor;
|
||||
|
||||
|
||||
END FPU.
|
||||
@@ -0,0 +1,176 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2020, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE HOST;
|
||||
|
||||
IMPORT SYSTEM, Trap;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
slash* = "\";
|
||||
eol* = 0DX + 0AX;
|
||||
|
||||
bit_depth* = 32;
|
||||
maxint* = 7FFFFFFFH;
|
||||
minint* = 80000000H;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
maxreal*: REAL;
|
||||
|
||||
|
||||
PROCEDURE syscall0 (fn: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
Trap.syscall(SYSTEM.ADR(fn))
|
||||
RETURN fn
|
||||
END syscall0;
|
||||
|
||||
|
||||
PROCEDURE syscall1 (fn, p1: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
Trap.syscall(SYSTEM.ADR(fn))
|
||||
RETURN fn
|
||||
END syscall1;
|
||||
|
||||
|
||||
PROCEDURE syscall2 (fn, p1, p2: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
Trap.syscall(SYSTEM.ADR(fn))
|
||||
RETURN fn
|
||||
END syscall2;
|
||||
|
||||
|
||||
PROCEDURE syscall3 (fn, p1, p2, p3: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
Trap.syscall(SYSTEM.ADR(fn))
|
||||
RETURN fn
|
||||
END syscall3;
|
||||
|
||||
|
||||
PROCEDURE syscall4 (fn, p1, p2, p3, p4: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
Trap.syscall(SYSTEM.ADR(fn))
|
||||
RETURN fn
|
||||
END syscall4;
|
||||
|
||||
|
||||
PROCEDURE ExitProcess* (code: INTEGER);
|
||||
BEGIN
|
||||
code := syscall1(0, code)
|
||||
END ExitProcess;
|
||||
|
||||
|
||||
PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
|
||||
VAR
|
||||
a: INTEGER;
|
||||
BEGIN
|
||||
a := syscall2(1, LEN(path), SYSTEM.ADR(path[0]))
|
||||
END GetCurrentDirectory;
|
||||
|
||||
|
||||
PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
|
||||
BEGIN
|
||||
n := syscall3(2, n, LEN(s), SYSTEM.ADR(s[0]))
|
||||
END GetArg;
|
||||
|
||||
|
||||
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
|
||||
RETURN syscall4(3, F, LEN(Buffer), SYSTEM.ADR(Buffer[0]), bytes)
|
||||
END FileRead;
|
||||
|
||||
|
||||
PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
|
||||
RETURN syscall4(4, F, LEN(Buffer), SYSTEM.ADR(Buffer[0]), bytes)
|
||||
END FileWrite;
|
||||
|
||||
|
||||
PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
|
||||
RETURN syscall2(5, LEN(FName), SYSTEM.ADR(FName[0]))
|
||||
END FileCreate;
|
||||
|
||||
|
||||
PROCEDURE FileClose* (F: INTEGER);
|
||||
BEGIN
|
||||
F := syscall1(6, F)
|
||||
END FileClose;
|
||||
|
||||
|
||||
PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
|
||||
RETURN syscall2(7, LEN(FName), SYSTEM.ADR(FName[0]))
|
||||
END FileOpen;
|
||||
|
||||
|
||||
PROCEDURE chmod* (FName: ARRAY OF CHAR);
|
||||
VAR
|
||||
a: INTEGER;
|
||||
BEGIN
|
||||
a := syscall2(12, LEN(FName), SYSTEM.ADR(FName[0]))
|
||||
END chmod;
|
||||
|
||||
|
||||
PROCEDURE OutChar* (c: CHAR);
|
||||
VAR
|
||||
a: INTEGER;
|
||||
BEGIN
|
||||
a := syscall1(8, ORD(c))
|
||||
END OutChar;
|
||||
|
||||
|
||||
PROCEDURE GetTickCount* (): INTEGER;
|
||||
RETURN syscall0(9)
|
||||
END GetTickCount;
|
||||
|
||||
|
||||
PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
|
||||
RETURN syscall2(11, LEN(path), SYSTEM.ADR(path[0])) # 0
|
||||
END isRelative;
|
||||
|
||||
|
||||
PROCEDURE UnixTime* (): INTEGER;
|
||||
RETURN syscall0(10)
|
||||
END UnixTime;
|
||||
|
||||
|
||||
PROCEDURE s2d (x: INTEGER; VAR h, l: INTEGER);
|
||||
VAR
|
||||
s, e, f: INTEGER;
|
||||
BEGIN
|
||||
s := ASR(x, 31) MOD 2;
|
||||
f := x MOD 800000H;
|
||||
e := (x DIV 800000H) MOD 256;
|
||||
IF e = 255 THEN
|
||||
e := 2047
|
||||
ELSE
|
||||
INC(e, 896)
|
||||
END;
|
||||
h := LSL(s, 31) + LSL(e, 20) + (f DIV 8);
|
||||
l := (f MOD 8) * 20000000H
|
||||
END s2d;
|
||||
|
||||
|
||||
PROCEDURE d2s* (x: REAL): INTEGER;
|
||||
VAR
|
||||
i: INTEGER;
|
||||
BEGIN
|
||||
SYSTEM.GET(SYSTEM.ADR(x), i)
|
||||
RETURN i
|
||||
END d2s;
|
||||
|
||||
|
||||
PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
s2d(d2s(x), b, a)
|
||||
RETURN a
|
||||
END splitf;
|
||||
|
||||
|
||||
BEGIN
|
||||
maxreal := 1.9;
|
||||
PACK(maxreal, 127)
|
||||
END HOST.
|
||||
@@ -0,0 +1,269 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2016, 2018, 2020, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE Out;
|
||||
|
||||
IMPORT HOST, SYSTEM;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
d = 1.0 - 5.0E-12;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
Realp: PROCEDURE (x: REAL; width: INTEGER);
|
||||
|
||||
|
||||
PROCEDURE Char* (c: CHAR);
|
||||
BEGIN
|
||||
HOST.OutChar(c)
|
||||
END Char;
|
||||
|
||||
|
||||
PROCEDURE String* (s: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, n: INTEGER;
|
||||
|
||||
BEGIN
|
||||
n := LENGTH(s) - 1;
|
||||
FOR i := 0 TO n DO
|
||||
Char(s[i])
|
||||
END
|
||||
END String;
|
||||
|
||||
|
||||
PROCEDURE Int* (x, width: INTEGER);
|
||||
VAR
|
||||
i, a: INTEGER;
|
||||
str: ARRAY 12 OF CHAR;
|
||||
|
||||
BEGIN
|
||||
IF x = 80000000H THEN
|
||||
COPY("-2147483648", str);
|
||||
DEC(width, 11)
|
||||
ELSE
|
||||
i := 0;
|
||||
IF x < 0 THEN
|
||||
x := -x;
|
||||
i := 1;
|
||||
str[0] := "-"
|
||||
END;
|
||||
|
||||
a := x;
|
||||
REPEAT
|
||||
INC(i);
|
||||
a := a DIV 10
|
||||
UNTIL a = 0;
|
||||
|
||||
str[i] := 0X;
|
||||
DEC(width, i);
|
||||
|
||||
REPEAT
|
||||
DEC(i);
|
||||
str[i] := CHR(x MOD 10 + ORD("0"));
|
||||
x := x DIV 10
|
||||
UNTIL x = 0
|
||||
END;
|
||||
|
||||
WHILE width > 0 DO
|
||||
Char(20X);
|
||||
DEC(width)
|
||||
END;
|
||||
|
||||
String(str)
|
||||
END Int;
|
||||
|
||||
|
||||
PROCEDURE IsNan (x: REAL): BOOLEAN;
|
||||
RETURN x # x
|
||||
END IsNan;
|
||||
|
||||
|
||||
PROCEDURE IsInf (x: REAL): BOOLEAN;
|
||||
RETURN ABS(x) = SYSTEM.INF()
|
||||
END IsInf;
|
||||
|
||||
|
||||
PROCEDURE OutInf (x: REAL; width: INTEGER);
|
||||
VAR
|
||||
s: ARRAY 5 OF CHAR;
|
||||
|
||||
BEGIN
|
||||
DEC(width, 4);
|
||||
IF x # x THEN
|
||||
s := " Nan"
|
||||
ELSIF x = SYSTEM.INF() THEN
|
||||
s := "+Inf"
|
||||
ELSIF x = -SYSTEM.INF() THEN
|
||||
s := "-Inf"
|
||||
END;
|
||||
|
||||
WHILE width > 0 DO
|
||||
Char(20X);
|
||||
DEC(width)
|
||||
END;
|
||||
|
||||
String(s)
|
||||
END OutInf;
|
||||
|
||||
|
||||
PROCEDURE Ln*;
|
||||
BEGIN
|
||||
Char(0DX);
|
||||
Char(0AX)
|
||||
END Ln;
|
||||
|
||||
|
||||
PROCEDURE _FixReal(x: REAL; width, p: INTEGER);
|
||||
VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN;
|
||||
BEGIN
|
||||
IF IsNan(x) OR IsInf(x) THEN
|
||||
OutInf(x, width)
|
||||
ELSIF p < 0 THEN
|
||||
Realp(x, width)
|
||||
ELSE
|
||||
len := 0;
|
||||
minus := FALSE;
|
||||
IF x < 0.0 THEN
|
||||
minus := TRUE;
|
||||
INC(len);
|
||||
x := ABS(x)
|
||||
END;
|
||||
e := 0;
|
||||
WHILE x >= 10.0 DO
|
||||
x := x / 10.0;
|
||||
INC(e)
|
||||
END;
|
||||
IF e >= 0 THEN
|
||||
len := len + e + p + 1;
|
||||
IF x > 9.0 + d THEN
|
||||
INC(len)
|
||||
END;
|
||||
IF p > 0 THEN
|
||||
INC(len)
|
||||
END
|
||||
ELSE
|
||||
len := len + p + 2
|
||||
END;
|
||||
FOR i := 1 TO width - len DO
|
||||
Char(" ")
|
||||
END;
|
||||
IF minus THEN
|
||||
Char("-")
|
||||
END;
|
||||
y := x;
|
||||
WHILE (y < 1.0) & (y # 0.0) DO
|
||||
y := y * 10.0;
|
||||
DEC(e)
|
||||
END;
|
||||
IF e < 0 THEN
|
||||
IF x - FLT(FLOOR(x)) > d THEN
|
||||
Char("1");
|
||||
x := 0.0
|
||||
ELSE
|
||||
Char("0");
|
||||
x := x * 10.0
|
||||
END
|
||||
ELSE
|
||||
WHILE e >= 0 DO
|
||||
IF x - FLT(FLOOR(x)) > d THEN
|
||||
IF x > 9.0 THEN
|
||||
String("10")
|
||||
ELSE
|
||||
Char(CHR(FLOOR(x) + ORD("0") + 1))
|
||||
END;
|
||||
x := 0.0
|
||||
ELSE
|
||||
Char(CHR(FLOOR(x) + ORD("0")));
|
||||
x := (x - FLT(FLOOR(x))) * 10.0
|
||||
END;
|
||||
DEC(e)
|
||||
END
|
||||
END;
|
||||
IF p > 0 THEN
|
||||
Char(".")
|
||||
END;
|
||||
WHILE p > 0 DO
|
||||
IF x - FLT(FLOOR(x)) > d THEN
|
||||
Char(CHR(FLOOR(x) + ORD("0") + 1));
|
||||
x := 0.0
|
||||
ELSE
|
||||
Char(CHR(FLOOR(x) + ORD("0")));
|
||||
x := (x - FLT(FLOOR(x))) * 10.0
|
||||
END;
|
||||
DEC(p)
|
||||
END
|
||||
END
|
||||
END _FixReal;
|
||||
|
||||
PROCEDURE Real*(x: REAL; width: INTEGER);
|
||||
VAR e, n, i: INTEGER; minus: BOOLEAN;
|
||||
BEGIN
|
||||
IF IsNan(x) OR IsInf(x) THEN
|
||||
OutInf(x, width)
|
||||
ELSE
|
||||
e := 0;
|
||||
n := 0;
|
||||
IF width > 22 THEN
|
||||
n := width - 22;
|
||||
width := 22
|
||||
ELSIF width < 8 THEN
|
||||
width := 8
|
||||
END;
|
||||
width := width - 4;
|
||||
IF x < 0.0 THEN
|
||||
x := -x;
|
||||
minus := TRUE
|
||||
ELSE
|
||||
minus := FALSE
|
||||
END;
|
||||
WHILE x >= 10.0 DO
|
||||
x := x / 10.0;
|
||||
INC(e)
|
||||
END;
|
||||
WHILE (x < 1.0) & (x # 0.0) DO
|
||||
x := x * 10.0;
|
||||
DEC(e)
|
||||
END;
|
||||
IF x > 9.0 + d THEN
|
||||
x := 1.0;
|
||||
INC(e)
|
||||
END;
|
||||
FOR i := 1 TO n DO
|
||||
Char(" ")
|
||||
END;
|
||||
IF minus THEN
|
||||
x := -x
|
||||
END;
|
||||
Realp := Real;
|
||||
_FixReal(x, width, width - 3);
|
||||
Char("E");
|
||||
IF e >= 0 THEN
|
||||
Char("+")
|
||||
ELSE
|
||||
Char("-");
|
||||
e := ABS(e)
|
||||
END;
|
||||
IF e < 10 THEN
|
||||
Char("0")
|
||||
END;
|
||||
Int(e, 0)
|
||||
END
|
||||
END Real;
|
||||
|
||||
PROCEDURE FixReal*(x: REAL; width, p: INTEGER);
|
||||
BEGIN
|
||||
Realp := Real;
|
||||
_FixReal(x, width, p)
|
||||
END FixReal;
|
||||
|
||||
PROCEDURE Open*;
|
||||
END Open;
|
||||
|
||||
END Out.
|
||||
@@ -0,0 +1,394 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2019-2020, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE RTL;
|
||||
|
||||
IMPORT SYSTEM, F := FPU, Trap;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
bit_depth = 32;
|
||||
maxint = 7FFFFFFFH;
|
||||
minint = 80000000H;
|
||||
|
||||
WORD = bit_depth DIV 8;
|
||||
MAX_SET = bit_depth - 1;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
Heap, Types, TypesCount: INTEGER;
|
||||
|
||||
|
||||
PROCEDURE [code] sp (): INTEGER
|
||||
22, 0, 4; (* MOV R0, SP *)
|
||||
|
||||
|
||||
PROCEDURE _error* (modnum, module, err, line: INTEGER);
|
||||
BEGIN
|
||||
Trap.trap(modnum, module, err, line)
|
||||
END _error;
|
||||
|
||||
|
||||
PROCEDURE _fmul* (b, a: INTEGER): INTEGER;
|
||||
RETURN F.mul(b, a)
|
||||
END _fmul;
|
||||
|
||||
|
||||
PROCEDURE _fdiv* (b, a: INTEGER): INTEGER;
|
||||
RETURN F.div(b, a)
|
||||
END _fdiv;
|
||||
|
||||
|
||||
PROCEDURE _fdivi* (b, a: INTEGER): INTEGER;
|
||||
RETURN F.div(a, b)
|
||||
END _fdivi;
|
||||
|
||||
|
||||
PROCEDURE _fadd* (b, a: INTEGER): INTEGER;
|
||||
RETURN F.add(b, a)
|
||||
END _fadd;
|
||||
|
||||
|
||||
PROCEDURE _fsub* (b, a: INTEGER): INTEGER;
|
||||
RETURN F.sub(b, a)
|
||||
END _fsub;
|
||||
|
||||
|
||||
PROCEDURE _fsubi* (b, a: INTEGER): INTEGER;
|
||||
RETURN F.sub(a, b)
|
||||
END _fsubi;
|
||||
|
||||
|
||||
PROCEDURE _fcmp* (op, b, a: INTEGER): BOOLEAN;
|
||||
RETURN F.cmp(op, b, a)
|
||||
END _fcmp;
|
||||
|
||||
|
||||
PROCEDURE _floor* (x: INTEGER): INTEGER;
|
||||
RETURN F.floor(x)
|
||||
END _floor;
|
||||
|
||||
|
||||
PROCEDURE _flt* (x: INTEGER): INTEGER;
|
||||
RETURN F.flt(x)
|
||||
END _flt;
|
||||
|
||||
|
||||
PROCEDURE _pack* (n: INTEGER; VAR x: SET);
|
||||
BEGIN
|
||||
n := LSL((LSR(ORD(x), 23) MOD 256 + n) MOD 256, 23);
|
||||
x := x - {23..30} + BITS(n)
|
||||
END _pack;
|
||||
|
||||
|
||||
PROCEDURE _unpk* (VAR n: INTEGER; VAR x: SET);
|
||||
BEGIN
|
||||
n := LSR(ORD(x), 23) MOD 256 - 127;
|
||||
x := x - {30} + {23..29}
|
||||
END _unpk;
|
||||
|
||||
|
||||
PROCEDURE _rot* (VAR A: ARRAY OF INTEGER);
|
||||
VAR
|
||||
i, n, k: INTEGER;
|
||||
|
||||
BEGIN
|
||||
k := LEN(A) - 1;
|
||||
n := A[0];
|
||||
i := 0;
|
||||
WHILE i < k DO
|
||||
A[i] := A[i + 1];
|
||||
INC(i)
|
||||
END;
|
||||
A[k] := n
|
||||
END _rot;
|
||||
|
||||
|
||||
PROCEDURE _set* (b, a: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
|
||||
IF b > MAX_SET THEN
|
||||
b := MAX_SET
|
||||
END;
|
||||
IF a < 0 THEN
|
||||
a := 0
|
||||
END;
|
||||
a := LSR(ASR(minint, b - a), MAX_SET - b)
|
||||
ELSE
|
||||
a := 0
|
||||
END
|
||||
|
||||
RETURN a
|
||||
END _set;
|
||||
|
||||
|
||||
PROCEDURE _set1* (a: INTEGER): INTEGER;
|
||||
BEGIN
|
||||
IF ASR(a, 5) = 0 THEN
|
||||
a := LSL(1, a)
|
||||
ELSE
|
||||
a := 0
|
||||
END
|
||||
RETURN a
|
||||
END _set1;
|
||||
|
||||
|
||||
PROCEDURE _length* (len, str: INTEGER): INTEGER;
|
||||
VAR
|
||||
c: CHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := 0;
|
||||
REPEAT
|
||||
SYSTEM.GET(str, c);
|
||||
INC(str);
|
||||
DEC(len);
|
||||
INC(res)
|
||||
UNTIL (len = 0) OR (c = 0X);
|
||||
|
||||
RETURN res - ORD(c = 0X)
|
||||
END _length;
|
||||
|
||||
|
||||
PROCEDURE _move* (bytes, dest, source: INTEGER);
|
||||
VAR
|
||||
b: BYTE;
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
WHILE ((source MOD WORD # 0) OR (dest MOD WORD # 0)) & (bytes > 0) DO
|
||||
SYSTEM.GET(source, b);
|
||||
SYSTEM.PUT8(dest, b);
|
||||
INC(source);
|
||||
INC(dest);
|
||||
DEC(bytes)
|
||||
END;
|
||||
|
||||
WHILE bytes >= WORD DO
|
||||
SYSTEM.GET(source, i);
|
||||
SYSTEM.PUT(dest, i);
|
||||
INC(source, WORD);
|
||||
INC(dest, WORD);
|
||||
DEC(bytes, WORD)
|
||||
END;
|
||||
|
||||
WHILE bytes > 0 DO
|
||||
SYSTEM.GET(source, b);
|
||||
SYSTEM.PUT8(dest, b);
|
||||
INC(source);
|
||||
INC(dest);
|
||||
DEC(bytes)
|
||||
END
|
||||
END _move;
|
||||
|
||||
|
||||
PROCEDURE _lengthw* (len, str: INTEGER): INTEGER;
|
||||
VAR
|
||||
c: WCHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := 0;
|
||||
REPEAT
|
||||
SYSTEM.GET(str, c);
|
||||
INC(str, 2);
|
||||
DEC(len);
|
||||
INC(res)
|
||||
UNTIL (len = 0) OR (c = 0X);
|
||||
|
||||
RETURN res - ORD(c = 0X)
|
||||
END _lengthw;
|
||||
|
||||
|
||||
PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
|
||||
VAR
|
||||
A, B: CHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := 0;
|
||||
WHILE n > 0 DO
|
||||
SYSTEM.GET(a, A); INC(a);
|
||||
SYSTEM.GET(b, B); INC(b);
|
||||
DEC(n);
|
||||
IF A # B THEN
|
||||
res := ORD(A) - ORD(B);
|
||||
n := 0
|
||||
ELSIF A = 0X THEN
|
||||
n := 0
|
||||
END
|
||||
END
|
||||
RETURN res
|
||||
END strncmp;
|
||||
|
||||
|
||||
PROCEDURE _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
bRes: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
res := strncmp(str1, str2, MIN(len1, len2));
|
||||
IF res = 0 THEN
|
||||
res := _length(len1, str1) - _length(len2, str2)
|
||||
END;
|
||||
|
||||
CASE op OF
|
||||
|0: bRes := res = 0
|
||||
|1: bRes := res # 0
|
||||
|2: bRes := res < 0
|
||||
|3: bRes := res <= 0
|
||||
|4: bRes := res > 0
|
||||
|5: bRes := res >= 0
|
||||
END
|
||||
|
||||
RETURN bRes
|
||||
END _strcmp;
|
||||
|
||||
|
||||
PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
|
||||
VAR
|
||||
A, B: WCHAR;
|
||||
res: INTEGER;
|
||||
|
||||
BEGIN
|
||||
res := 0;
|
||||
WHILE n > 0 DO
|
||||
SYSTEM.GET(a, A); INC(a, 2);
|
||||
SYSTEM.GET(b, B); INC(b, 2);
|
||||
DEC(n);
|
||||
IF A # B THEN
|
||||
res := ORD(A) - ORD(B);
|
||||
n := 0
|
||||
ELSIF A = WCHR(0) THEN
|
||||
n := 0
|
||||
END
|
||||
END
|
||||
RETURN res
|
||||
END strncmpw;
|
||||
|
||||
|
||||
PROCEDURE _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
res: INTEGER;
|
||||
bRes: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
res := strncmpw(str1, str2, MIN(len1, len2));
|
||||
IF res = 0 THEN
|
||||
res := _lengthw(len1, str1) - _lengthw(len2, str2)
|
||||
END;
|
||||
|
||||
CASE op OF
|
||||
|0: bRes := res = 0
|
||||
|1: bRes := res # 0
|
||||
|2: bRes := res < 0
|
||||
|3: bRes := res <= 0
|
||||
|4: bRes := res > 0
|
||||
|5: bRes := res >= 0
|
||||
END
|
||||
|
||||
RETURN bRes
|
||||
END _strcmpw;
|
||||
|
||||
|
||||
PROCEDURE _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
res: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
IF len_src > len_dst THEN
|
||||
res := FALSE
|
||||
ELSE
|
||||
_move(len_src * base_size, dst, src);
|
||||
res := TRUE
|
||||
END
|
||||
|
||||
RETURN res
|
||||
END _arrcpy;
|
||||
|
||||
|
||||
PROCEDURE _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
|
||||
BEGIN
|
||||
_move(MIN(len_dst, len_src) * chr_size, dst, src)
|
||||
END _strcpy;
|
||||
|
||||
|
||||
PROCEDURE _new* (t, size: INTEGER; VAR p: INTEGER);
|
||||
BEGIN
|
||||
IF Heap + size < sp() - 64 THEN
|
||||
p := Heap + WORD;
|
||||
REPEAT
|
||||
SYSTEM.PUT(Heap, t);
|
||||
INC(Heap, WORD);
|
||||
DEC(size, WORD);
|
||||
t := 0
|
||||
UNTIL size = 0
|
||||
ELSE
|
||||
p := 0
|
||||
END
|
||||
END _new;
|
||||
|
||||
|
||||
PROCEDURE _guard* (t, p: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
type: INTEGER;
|
||||
|
||||
BEGIN
|
||||
SYSTEM.GET(p, p);
|
||||
IF p # 0 THEN
|
||||
SYSTEM.GET(p - WORD, type);
|
||||
WHILE (type # t) & (type # 0) DO
|
||||
SYSTEM.GET(Types + type * WORD, type)
|
||||
END
|
||||
ELSE
|
||||
type := t
|
||||
END
|
||||
|
||||
RETURN type = t
|
||||
END _guard;
|
||||
|
||||
|
||||
PROCEDURE _is* (t, p: INTEGER): BOOLEAN;
|
||||
VAR
|
||||
type: INTEGER;
|
||||
|
||||
BEGIN
|
||||
type := 0;
|
||||
IF p # 0 THEN
|
||||
SYSTEM.GET(p - WORD, type);
|
||||
WHILE (type # t) & (type # 0) DO
|
||||
SYSTEM.GET(Types + type * WORD, type)
|
||||
END
|
||||
END
|
||||
|
||||
RETURN type = t
|
||||
END _is;
|
||||
|
||||
|
||||
PROCEDURE _guardrec* (t0, t1: INTEGER): BOOLEAN;
|
||||
BEGIN
|
||||
WHILE (t1 # t0) & (t1 # 0) DO
|
||||
SYSTEM.GET(Types + t1 * WORD, t1)
|
||||
END
|
||||
|
||||
RETURN t1 = t0
|
||||
END _guardrec;
|
||||
|
||||
|
||||
PROCEDURE _init* (tcount, heap, types: INTEGER);
|
||||
BEGIN
|
||||
Heap := heap;
|
||||
TypesCount := tcount;
|
||||
Types := types
|
||||
END _init;
|
||||
|
||||
|
||||
END RTL.
|
||||
@@ -0,0 +1,124 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2020, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
MODULE Trap;
|
||||
|
||||
IMPORT SYSTEM;
|
||||
|
||||
|
||||
PROCEDURE [code] syscall* (ptr: INTEGER)
|
||||
22, 0, 4, (* MOV R0, SP *)
|
||||
27, 0, 4, (* ADD R0, 4 *)
|
||||
9, 0, 0, (* LDR32 R0, R0 *)
|
||||
80, 0, 0; (* SYSCALL R0 *)
|
||||
|
||||
|
||||
PROCEDURE Char (c: CHAR);
|
||||
VAR
|
||||
a: ARRAY 2 OF INTEGER;
|
||||
|
||||
BEGIN
|
||||
a[0] := 8;
|
||||
a[1] := ORD(c);
|
||||
syscall(SYSTEM.ADR(a[0]))
|
||||
END Char;
|
||||
|
||||
|
||||
PROCEDURE String (s: ARRAY OF CHAR);
|
||||
VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE s[i] # 0X DO
|
||||
Char(s[i]);
|
||||
INC(i)
|
||||
END
|
||||
END String;
|
||||
|
||||
|
||||
PROCEDURE PString (ptr: INTEGER);
|
||||
VAR
|
||||
c: CHAR;
|
||||
|
||||
BEGIN
|
||||
SYSTEM.GET(ptr, c);
|
||||
WHILE c # 0X DO
|
||||
Char(c);
|
||||
INC(ptr);
|
||||
SYSTEM.GET(ptr, c)
|
||||
END
|
||||
END PString;
|
||||
|
||||
|
||||
PROCEDURE Ln;
|
||||
BEGIN
|
||||
String(0DX + 0AX)
|
||||
END Ln;
|
||||
|
||||
|
||||
PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, a: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := 0;
|
||||
a := x;
|
||||
REPEAT
|
||||
INC(i);
|
||||
a := a DIV 10
|
||||
UNTIL a = 0;
|
||||
|
||||
str[i] := 0X;
|
||||
|
||||
REPEAT
|
||||
DEC(i);
|
||||
str[i] := CHR(x MOD 10 + ORD("0"));
|
||||
x := x DIV 10
|
||||
UNTIL x = 0
|
||||
END IntToStr;
|
||||
|
||||
|
||||
PROCEDURE Int (x: INTEGER);
|
||||
VAR
|
||||
s: ARRAY 32 OF CHAR;
|
||||
|
||||
BEGIN
|
||||
IntToStr(x, s);
|
||||
String(s)
|
||||
END Int;
|
||||
|
||||
|
||||
PROCEDURE trap* (modnum, module, err, line: INTEGER);
|
||||
VAR
|
||||
s: ARRAY 32 OF CHAR;
|
||||
|
||||
BEGIN
|
||||
CASE err OF
|
||||
| 1: s := "assertion failure"
|
||||
| 2: s := "NIL dereference"
|
||||
| 3: s := "bad divisor"
|
||||
| 4: s := "NIL procedure call"
|
||||
| 5: s := "type guard error"
|
||||
| 6: s := "index out of range"
|
||||
| 7: s := "invalid CASE"
|
||||
| 8: s := "array assignment error"
|
||||
| 9: s := "CHR out of range"
|
||||
|10: s := "WCHR out of range"
|
||||
|11: s := "BYTE out of range"
|
||||
END;
|
||||
|
||||
Ln;
|
||||
String("error ("); Int(err); String("): "); String(s); Ln;
|
||||
String("module: "); PString(module); Ln;
|
||||
String("line: "); Int(line); Ln;
|
||||
|
||||
SYSTEM.CODE(0, 0, 0) (* STOP *)
|
||||
END trap;
|
||||
|
||||
|
||||
END Trap.
|
||||
@@ -317,7 +317,7 @@ END _strcpy;
|
||||
|
||||
PROCEDURE _new* (t, size: INTEGER; VAR p: INTEGER);
|
||||
BEGIN
|
||||
IF Heap + size < sp() - 16 THEN
|
||||
IF Heap + size < sp() - 64 THEN
|
||||
p := Heap + WORD;
|
||||
REPEAT
|
||||
SYSTEM.PUT(Heap, t);
|
||||
|
||||
+17
-30
@@ -372,33 +372,29 @@ END PCharToStr;
|
||||
|
||||
PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, a, b: INTEGER;
|
||||
c: CHAR;
|
||||
i, a: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := 0;
|
||||
a := x;
|
||||
REPEAT
|
||||
str[i] := CHR(x MOD 10 + ORD("0"));
|
||||
x := x DIV 10;
|
||||
INC(i)
|
||||
UNTIL x = 0;
|
||||
INC(i);
|
||||
a := a DIV 10
|
||||
UNTIL a = 0;
|
||||
|
||||
a := 0;
|
||||
b := i - 1;
|
||||
WHILE a < b DO
|
||||
c := str[a];
|
||||
str[a] := str[b];
|
||||
str[b] := c;
|
||||
INC(a);
|
||||
DEC(b)
|
||||
END;
|
||||
str[i] := 0X
|
||||
str[i] := 0X;
|
||||
|
||||
REPEAT
|
||||
DEC(i);
|
||||
str[i] := CHR(x MOD 10 + ORD("0"));
|
||||
x := x DIV 10
|
||||
UNTIL x = 0
|
||||
END IntToStr;
|
||||
|
||||
|
||||
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
|
||||
VAR
|
||||
n1, n2, i, j: INTEGER;
|
||||
n1, n2: INTEGER;
|
||||
|
||||
BEGIN
|
||||
n1 := LENGTH(s1);
|
||||
@@ -406,15 +402,8 @@ BEGIN
|
||||
|
||||
ASSERT(n1 + n2 < LEN(s1));
|
||||
|
||||
i := 0;
|
||||
j := n1;
|
||||
WHILE i < n2 DO
|
||||
s1[j] := s2[i];
|
||||
INC(i);
|
||||
INC(j)
|
||||
END;
|
||||
|
||||
s1[j] := 0X
|
||||
SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
|
||||
s1[n1 + n2] := 0X
|
||||
END append;
|
||||
|
||||
|
||||
@@ -437,10 +426,8 @@ BEGIN
|
||||
|11: s := "BYTE out of range"
|
||||
END;
|
||||
|
||||
append(s, API.eol);
|
||||
|
||||
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
|
||||
append(s, "line: "); IntToStr(line, temp); append(s, temp);
|
||||
append(s, API.eol + "module: "); PCharToStr(module, temp); append(s, temp);
|
||||
append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
|
||||
|
||||
API.DebugMsg(SYSTEM.ADR(s[0]), name);
|
||||
|
||||
|
||||
+17
-30
@@ -350,33 +350,29 @@ END PCharToStr;
|
||||
|
||||
PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, a, b: INTEGER;
|
||||
c: CHAR;
|
||||
i, a: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := 0;
|
||||
a := x;
|
||||
REPEAT
|
||||
str[i] := CHR(x MOD 10 + ORD("0"));
|
||||
x := x DIV 10;
|
||||
INC(i)
|
||||
UNTIL x = 0;
|
||||
INC(i);
|
||||
a := a DIV 10
|
||||
UNTIL a = 0;
|
||||
|
||||
a := 0;
|
||||
b := i - 1;
|
||||
WHILE a < b DO
|
||||
c := str[a];
|
||||
str[a] := str[b];
|
||||
str[b] := c;
|
||||
INC(a);
|
||||
DEC(b)
|
||||
END;
|
||||
str[i] := 0X
|
||||
str[i] := 0X;
|
||||
|
||||
REPEAT
|
||||
DEC(i);
|
||||
str[i] := CHR(x MOD 10 + ORD("0"));
|
||||
x := x DIV 10
|
||||
UNTIL x = 0
|
||||
END IntToStr;
|
||||
|
||||
|
||||
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
|
||||
VAR
|
||||
n1, n2, i, j: INTEGER;
|
||||
n1, n2: INTEGER;
|
||||
|
||||
BEGIN
|
||||
n1 := LENGTH(s1);
|
||||
@@ -384,15 +380,8 @@ BEGIN
|
||||
|
||||
ASSERT(n1 + n2 < LEN(s1));
|
||||
|
||||
i := 0;
|
||||
j := n1;
|
||||
WHILE i < n2 DO
|
||||
s1[j] := s2[i];
|
||||
INC(i);
|
||||
INC(j)
|
||||
END;
|
||||
|
||||
s1[j] := 0X
|
||||
SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
|
||||
s1[n1 + n2] := 0X
|
||||
END append;
|
||||
|
||||
|
||||
@@ -415,10 +404,8 @@ BEGIN
|
||||
|11: s := "BYTE out of range"
|
||||
END;
|
||||
|
||||
append(s, API.eol);
|
||||
|
||||
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
|
||||
append(s, "line: "); IntToStr(line, temp); append(s, temp);
|
||||
append(s, API.eol + "module: "); PCharToStr(module, temp); append(s, temp);
|
||||
append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
|
||||
|
||||
API.DebugMsg(SYSTEM.ADR(s[0]), name);
|
||||
|
||||
|
||||
@@ -211,6 +211,7 @@ BEGIN
|
||||
|205: Error1("not enough parameters")
|
||||
|206: Error1("bad parameter <target>")
|
||||
|207: Error3('inputfile name extension must be "', UTILS.FILE_EXT, '"')
|
||||
|208: Error1("not enough RAM")
|
||||
END
|
||||
END Error;
|
||||
|
||||
|
||||
+1315
File diff suppressed because it is too large.
Load diff
@@ -9,7 +9,7 @@ MODULE STATEMENTS;
|
||||
|
||||
IMPORT
|
||||
|
||||
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB,
|
||||
PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB, RVM32I,
|
||||
ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, TARGETS;
|
||||
|
||||
|
||||
@@ -3286,7 +3286,7 @@ BEGIN
|
||||
getproc(rtl, "_isrec", IL._isrec);
|
||||
getproc(rtl, "_dllentry", IL._dllentry);
|
||||
getproc(rtl, "_sofinit", IL._sofinit)
|
||||
ELSIF CPU = TARGETS.cpuTHUMB THEN
|
||||
ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I} THEN
|
||||
getproc(rtl, "_fmul", IL._fmul);
|
||||
getproc(rtl, "_fdiv", IL._fdiv);
|
||||
getproc(rtl, "_fdivi", IL._fdivi);
|
||||
@@ -3297,9 +3297,10 @@ BEGIN
|
||||
getproc(rtl, "_floor", IL._floor);
|
||||
getproc(rtl, "_flt", IL._flt);
|
||||
getproc(rtl, "_pack", IL._pack);
|
||||
getproc(rtl, "_unpk", IL._unpk)
|
||||
ELSE
|
||||
getproc(rtl, "_error", IL._error)
|
||||
getproc(rtl, "_unpk", IL._unpk);
|
||||
IF CPU = TARGETS.cpuRVM32I THEN
|
||||
getproc(rtl, "_error", IL._error)
|
||||
END
|
||||
END
|
||||
|
||||
END setrtl;
|
||||
@@ -3376,6 +3377,7 @@ BEGIN
|
||||
|TARGETS.cpuX86: X86.CodeGen(outname, target, options)
|
||||
|TARGETS.cpuMSP430: MSP430.CodeGen(outname, target, options)
|
||||
|TARGETS.cpuTHUMB: THUMB.CodeGen(outname, target, options)
|
||||
|TARGETS.cpuRVM32I: RVM32I.CodeGen(outname, target, options)
|
||||
END
|
||||
|
||||
END compile;
|
||||
|
||||
+32
-62
@@ -10,9 +10,20 @@ MODULE STRINGS;
|
||||
IMPORT UTILS;
|
||||
|
||||
|
||||
PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER);
|
||||
BEGIN
|
||||
WHILE count > 0 DO
|
||||
dst[dpos] := src[spos];
|
||||
INC(spos);
|
||||
INC(dpos);
|
||||
DEC(count)
|
||||
END
|
||||
END copy;
|
||||
|
||||
|
||||
PROCEDURE append* (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
|
||||
VAR
|
||||
n1, n2, i, j: INTEGER;
|
||||
n1, n2: INTEGER;
|
||||
|
||||
BEGIN
|
||||
n1 := LENGTH(s1);
|
||||
@@ -20,43 +31,14 @@ BEGIN
|
||||
|
||||
ASSERT(n1 + n2 < LEN(s1));
|
||||
|
||||
i := 0;
|
||||
j := n1;
|
||||
WHILE i < n2 DO
|
||||
s1[j] := s2[i];
|
||||
INC(i);
|
||||
INC(j)
|
||||
END;
|
||||
|
||||
s1[j] := 0X
|
||||
|
||||
copy(s2, s1, 0, n1, n2);
|
||||
s1[n1 + n2] := 0X
|
||||
END append;
|
||||
|
||||
|
||||
PROCEDURE reverse (VAR s: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, j: INTEGER;
|
||||
a, b: CHAR;
|
||||
|
||||
BEGIN
|
||||
i := 0;
|
||||
j := LENGTH(s) - 1;
|
||||
|
||||
WHILE i < j DO
|
||||
a := s[i];
|
||||
b := s[j];
|
||||
s[i] := b;
|
||||
s[j] := a;
|
||||
INC(i);
|
||||
DEC(j)
|
||||
END
|
||||
END reverse;
|
||||
|
||||
|
||||
PROCEDURE IntToStr* (x: INTEGER; VAR str: ARRAY OF CHAR);
|
||||
VAR
|
||||
i, a: INTEGER;
|
||||
minus: BOOLEAN;
|
||||
|
||||
BEGIN
|
||||
IF x = UTILS.minint THEN
|
||||
@@ -67,27 +49,26 @@ BEGIN
|
||||
END
|
||||
|
||||
ELSE
|
||||
|
||||
minus := x < 0;
|
||||
IF minus THEN
|
||||
x := -x
|
||||
END;
|
||||
i := 0;
|
||||
a := 0;
|
||||
REPEAT
|
||||
str[i] := CHR(x MOD 10 + ORD("0"));
|
||||
x := x DIV 10;
|
||||
INC(i)
|
||||
UNTIL x = 0;
|
||||
|
||||
IF minus THEN
|
||||
str[i] := "-";
|
||||
INC(i)
|
||||
IF x < 0 THEN
|
||||
x := -x;
|
||||
i := 1;
|
||||
str[0] := "-"
|
||||
END;
|
||||
|
||||
a := x;
|
||||
REPEAT
|
||||
INC(i);
|
||||
a := a DIV 10
|
||||
UNTIL a = 0;
|
||||
|
||||
str[i] := 0X;
|
||||
reverse(str)
|
||||
|
||||
REPEAT
|
||||
DEC(i);
|
||||
str[i] := CHR(x MOD 10 + ORD("0"));
|
||||
x := x DIV 10
|
||||
UNTIL x = 0
|
||||
END
|
||||
END IntToStr;
|
||||
|
||||
@@ -103,17 +84,6 @@ BEGIN
|
||||
END IntToHex;
|
||||
|
||||
|
||||
PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER);
|
||||
BEGIN
|
||||
WHILE count > 0 DO
|
||||
dst[dpos] := src[spos];
|
||||
INC(spos);
|
||||
INC(dpos);
|
||||
DEC(count)
|
||||
END
|
||||
END copy;
|
||||
|
||||
|
||||
PROCEDURE search* (s: ARRAY OF CHAR; VAR pos: INTEGER; c: CHAR; forward: BOOLEAN);
|
||||
VAR
|
||||
length: INTEGER;
|
||||
@@ -173,10 +143,10 @@ VAR
|
||||
i: INTEGER;
|
||||
|
||||
BEGIN
|
||||
i := 0;
|
||||
WHILE (i < LEN(str)) & (str[i] # 0X) DO
|
||||
i := LENGTH(str) - 1;
|
||||
WHILE i >= 0 DO
|
||||
cap(str[i]);
|
||||
INC(i)
|
||||
DEC(i)
|
||||
END
|
||||
END UpCase;
|
||||
|
||||
|
||||
+7
-3
@@ -24,13 +24,15 @@ CONST
|
||||
Linux64* = 11;
|
||||
Linux64SO* = 12;
|
||||
STM32CM3* = 13;
|
||||
RVM32I* = 14;
|
||||
|
||||
cpuX86* = 0; cpuAMD64* = 1; cpuMSP430* = 2; cpuTHUMB* = 3;
|
||||
cpuRVM32I* = 4;
|
||||
|
||||
osNONE* = 0; osWIN32* = 1; osWIN64* = 2;
|
||||
osLINUX32* = 3; osLINUX64* = 4; osKOS* = 5;
|
||||
|
||||
noDISPOSE = {MSP430, STM32CM3};
|
||||
noDISPOSE = {MSP430, STM32CM3, RVM32I};
|
||||
|
||||
noRTL = {MSP430};
|
||||
|
||||
@@ -49,9 +51,9 @@ TYPE
|
||||
|
||||
VAR
|
||||
|
||||
Targets*: ARRAY 14 OF TARGET;
|
||||
Targets*: ARRAY 15 OF TARGET;
|
||||
|
||||
CPUs: ARRAY 4 OF
|
||||
CPUs: ARRAY 5 OF
|
||||
RECORD
|
||||
BitDepth, InstrSize: INTEGER;
|
||||
LittleEndian: BOOLEAN
|
||||
@@ -123,6 +125,7 @@ BEGIN
|
||||
EnterCPU(cpuAMD64, 64, 1, TRUE);
|
||||
EnterCPU(cpuMSP430, 16, 2, TRUE);
|
||||
EnterCPU(cpuTHUMB, 32, 2, TRUE);
|
||||
EnterCPU(cpuRVM32I, 32, 4, TRUE);
|
||||
|
||||
Enter( MSP430, cpuMSP430, 0, osNONE, "msp430", "MSP430", ".hex");
|
||||
Enter( Win32C, cpuX86, 8, osWIN32, "win32con", "Windows32", ".exe");
|
||||
@@ -138,4 +141,5 @@ BEGIN
|
||||
Enter( Linux64, cpuAMD64, 8, osLINUX64, "linux64exe", "Linux64", "");
|
||||
Enter( Linux64SO, cpuAMD64, 8, osLINUX64, "linux64so", "Linux64", ".so");
|
||||
Enter( STM32CM3, cpuTHUMB, 4, osNONE, "stm32cm3", "STM32CM3", ".hex");
|
||||
Enter( RVM32I, cpuRVM32I, 4, osNONE, "rvm32i", "RVM32I", ".bin");
|
||||
END TARGETS.
|
||||
+1
-1
@@ -23,7 +23,7 @@ CONST
|
||||
max32* = 2147483647;
|
||||
|
||||
vMajor* = 1;
|
||||
vMinor* = 39;
|
||||
vMinor* = 40;
|
||||
|
||||
FILE_EXT* = ".ob07";
|
||||
RTL_NAME* = "RTL";
|
||||
|
||||
@@ -0,0 +1,575 @@
|
||||
(*
|
||||
BSD 2-Clause License
|
||||
|
||||
Copyright (c) 2020, Anton Krotov
|
||||
All rights reserved.
|
||||
*)
|
||||
|
||||
(*
|
||||
RVM32I executor and disassembler
|
||||
|
||||
for win32 only
|
||||
|
||||
Usage:
|
||||
RVM32I.exe <program file> -run [program parameters]
|
||||
RVM32I.exe <program file> -dis <output file>
|
||||
*)
|
||||
|
||||
MODULE RVM32I;
|
||||
|
||||
IMPORT SYSTEM, File, Args, Out, API, HOST, RTL;
|
||||
|
||||
|
||||
CONST
|
||||
|
||||
opSTOP = 0; opRET = 1; opENTER = 2; opNEG = 3; opNOT = 4; opABS = 5;
|
||||
opXCHG = 6; opLDR8 = 7; opLDR16 = 8; opLDR32 = 9; opPUSH = 10; opPUSHC = 11;
|
||||
opPOP = 12; opJGZ = 13; opJZ = 14; opJNZ = 15; opLLA = 16; opJGA = 17;
|
||||
opJLA = 18; opJMP = 19; opCALL = 20; opCALLI = 21;
|
||||
|
||||
opMOV = 22; opMUL = 24; opADD = 26; opSUB = 28; opDIV = 30; opMOD = 32;
|
||||
opSTR8 = 34; opSTR16 = 36; opSTR32 = 38; opINCL = 40; opEXCL = 42;
|
||||
opIN = 44; opAND = 46; opOR = 48; opXOR = 50; opASR = 52; opLSR = 54;
|
||||
opLSL = 56; opROR = 58; opMIN = 60; opMAX = 62; opEQ = 64; opNE = 66;
|
||||
opLT = 68; opLE = 70; opGT = 72; opGE = 74; opBT = 76;
|
||||
|
||||
opMOVC = 23; opMULC = 25; opADDC = 27; opSUBC = 29; opDIVC = 31; opMODC = 33;
|
||||
opSTR8C = 35; opSTR16C = 37; opSTR32C = 39; opINCLC = 41; opEXCLC = 43;
|
||||
opINC = 45; opANDC = 47; opORC = 49; opXORC = 51; opASRC = 53; opLSRC = 55;
|
||||
opLSLC = 57; opRORC = 59; opMINC = 61; opMAXC = 63; opEQC = 65; opNEC = 67;
|
||||
opLTC = 69; opLEC = 71; opGTC = 73; opGEC = 75; opBTC = 77;
|
||||
|
||||
opLEA = 78; opLABEL = 79; opSYSCALL = 80;
|
||||
|
||||
|
||||
ACC = 0; BP = 3; SP = 4;
|
||||
|
||||
Types = 0;
|
||||
Strings = 1;
|
||||
Global = 2;
|
||||
Heap = 3;
|
||||
Stack = 4;
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
COMMAND = POINTER TO RECORD
|
||||
|
||||
op, param1, param2: INTEGER;
|
||||
next: COMMAND
|
||||
|
||||
END;
|
||||
|
||||
|
||||
VAR
|
||||
|
||||
R: ARRAY 32 OF INTEGER;
|
||||
|
||||
Sections: ARRAY 5 OF RECORD address: INTEGER; name: ARRAY 16 OF CHAR END;
|
||||
|
||||
first, last: COMMAND;
|
||||
|
||||
Labels: ARRAY 30000 OF COMMAND;
|
||||
|
||||
F: INTEGER; buf: ARRAY 65536 OF BYTE; cnt: INTEGER;
|
||||
|
||||
|
||||
PROCEDURE syscall (ptr: INTEGER);
|
||||
VAR
|
||||
fn, p1, p2, p3, p4, r: INTEGER;
|
||||
|
||||
proc2: PROCEDURE (a, b: INTEGER): INTEGER;
|
||||
proc3: PROCEDURE (a, b, c: INTEGER): INTEGER;
|
||||
proc4: PROCEDURE (a, b, c, d: INTEGER): INTEGER;
|
||||
|
||||
BEGIN
|
||||
SYSTEM.GET(ptr, fn);
|
||||
SYSTEM.GET(ptr + 4, p1);
|
||||
SYSTEM.GET(ptr + 8, p2);
|
||||
SYSTEM.GET(ptr + 12, p3);
|
||||
SYSTEM.GET(ptr + 16, p4);
|
||||
CASE fn OF
|
||||
| 0: HOST.ExitProcess(p1)
|
||||
| 1: SYSTEM.PUT(SYSTEM.ADR(proc2), SYSTEM.ADR(HOST.GetCurrentDirectory));
|
||||
r := proc2(p1, p2)
|
||||
| 2: SYSTEM.PUT(SYSTEM.ADR(proc3), SYSTEM.ADR(HOST.GetArg));
|
||||
r := proc3(p1 + 2, p2, p3)
|
||||
| 3: SYSTEM.PUT(SYSTEM.ADR(proc4), SYSTEM.ADR(HOST.FileRead));
|
||||
SYSTEM.PUT(ptr, proc4(p1, p2, p3, p4))
|
||||
| 4: SYSTEM.PUT(SYSTEM.ADR(proc4), SYSTEM.ADR(HOST.FileWrite));
|
||||
SYSTEM.PUT(ptr, proc4(p1, p2, p3, p4))
|
||||
| 5: SYSTEM.PUT(SYSTEM.ADR(proc2), SYSTEM.ADR(HOST.FileCreate));
|
||||
SYSTEM.PUT(ptr, proc2(p1, p2))
|
||||
| 6: HOST.FileClose(p1)
|
||||
| 7: SYSTEM.PUT(SYSTEM.ADR(proc2), SYSTEM.ADR(HOST.FileOpen));
|
||||
SYSTEM.PUT(ptr, proc2(p1, p2))
|
||||
| 8: HOST.OutChar(CHR(p1))
|
||||
| 9: SYSTEM.PUT(ptr, HOST.GetTickCount())
|
||||
|10: SYSTEM.PUT(ptr, HOST.UnixTime())
|
||||
|11: SYSTEM.PUT(SYSTEM.ADR(proc2), SYSTEM.ADR(HOST.isRelative));
|
||||
SYSTEM.PUT(ptr, proc2(p1, p2))
|
||||
|12: SYSTEM.PUT(SYSTEM.ADR(proc2), SYSTEM.ADR(HOST.chmod));
|
||||
r := proc2(p1, p2)
|
||||
END
|
||||
END syscall;
|
||||
|
||||
|
||||
PROCEDURE exec;
|
||||
VAR
|
||||
cmd: COMMAND;
|
||||
param1, param2: INTEGER;
|
||||
temp: INTEGER;
|
||||
|
||||
BEGIN
|
||||
cmd := first;
|
||||
WHILE cmd # NIL DO
|
||||
param1 := cmd.param1;
|
||||
param2 := cmd.param2;
|
||||
CASE cmd.op OF
|
||||
|opSTOP: cmd := last
|
||||
|opRET: SYSTEM.MOVE(R[SP], SYSTEM.ADR(cmd), 4); INC(R[SP], 4)
|
||||
|opENTER: DEC(R[SP], 4); SYSTEM.PUT32(R[SP], R[BP]); R[BP] := R[SP]; WHILE param1 > 0 DO DEC(R[SP], 4); SYSTEM.PUT32(R[SP], 0); DEC(param1) END
|
||||
|opPOP: SYSTEM.GET32(R[SP], R[param1]); INC(R[SP], 4)
|
||||
|opNEG: R[param1] := -R[param1]
|
||||
|opNOT: R[param1] := ORD(-BITS(R[param1]))
|
||||
|opABS: R[param1] := ABS(R[param1])
|
||||
|opXCHG: temp := R[param1]; R[param1] := R[param2]; R[param2] := temp
|
||||
|opLDR8: SYSTEM.GET8(R[param2], R[param1]); R[param1] := R[param1] MOD 256;
|
||||
|opLDR16: SYSTEM.GET16(R[param2], R[param1]); R[param1] := R[param1] MOD 65536;
|
||||
|opLDR32: SYSTEM.GET32(R[param2], R[param1])
|
||||
|opPUSH: DEC(R[SP], 4); SYSTEM.PUT32(R[SP], R[param1])
|
||||
|opPUSHC: DEC(R[SP], 4); SYSTEM.PUT32(R[SP], param1)
|
||||
|opJGZ: IF R[param1] > 0 THEN cmd := Labels[cmd.param2] END
|
||||
|opJZ: IF R[param1] = 0 THEN cmd := Labels[cmd.param2] END
|
||||
|opJNZ: IF R[param1] # 0 THEN cmd := Labels[cmd.param2] END
|
||||
|opLLA: SYSTEM.MOVE(SYSTEM.ADR(Labels[cmd.param2]), SYSTEM.ADR(R[param1]), 4)
|
||||
|opJGA: IF R[ACC] > param1 THEN cmd := Labels[cmd.param2] END
|
||||
|opJLA: IF R[ACC] < param1 THEN cmd := Labels[cmd.param2] END
|
||||
|opJMP: cmd := Labels[cmd.param1]
|
||||
|opCALL: DEC(R[SP], 4); SYSTEM.MOVE(SYSTEM.ADR(cmd), R[SP], 4); cmd := Labels[cmd.param1]
|
||||
|opCALLI: DEC(R[SP], 4); SYSTEM.MOVE(SYSTEM.ADR(cmd), R[SP], 4); SYSTEM.MOVE(SYSTEM.ADR(R[param1]), SYSTEM.ADR(cmd), 4)
|
||||
|opMOV: R[param1] := R[param2]
|
||||
|opMOVC: R[param1] := param2
|
||||
|opMUL: R[param1] := R[param1] * R[param2]
|
||||
|opMULC: R[param1] := R[param1] * param2
|
||||
|opADD: INC(R[param1], R[param2])
|
||||
|opADDC: INC(R[param1], param2)
|
||||
|opSUB: DEC(R[param1], R[param2])
|
||||
|opSUBC: DEC(R[param1], param2)
|
||||
|opDIV: R[param1] := R[param1] DIV R[param2]
|
||||
|opDIVC: R[param1] := R[param1] DIV param2
|
||||
|opMOD: R[param1] := R[param1] MOD R[param2]
|
||||
|opMODC: R[param1] := R[param1] MOD param2
|
||||
|opSTR8: SYSTEM.PUT8(R[param1], R[param2])
|
||||
|opSTR8C: SYSTEM.PUT8(R[param1], param2)
|
||||
|opSTR16: SYSTEM.PUT16(R[param1], R[param2])
|
||||
|opSTR16C: SYSTEM.PUT16(R[param1], param2)
|
||||
|opSTR32: SYSTEM.PUT32(R[param1], R[param2])
|
||||
|opSTR32C: SYSTEM.PUT32(R[param1], param2)
|
||||
|opINCL: SYSTEM.GET32(R[param1], temp); SYSTEM.PUT32(R[param1], ORD(BITS(temp) + {R[param2]}))
|
||||
|opINCLC: SYSTEM.GET32(R[param1], temp); SYSTEM.PUT32(R[param1], ORD(BITS(temp) + {param2}))
|
||||
|opEXCL: SYSTEM.GET32(R[param1], temp); SYSTEM.PUT32(R[param1], ORD(BITS(temp) - {R[param2]}))
|
||||
|opEXCLC: SYSTEM.GET32(R[param1], temp); SYSTEM.PUT32(R[param1], ORD(BITS(temp) - {param2}))
|
||||
|opIN: R[param1] := ORD(R[param1] IN BITS(R[param2]))
|
||||
|opINC: R[param1] := ORD(R[param1] IN BITS(param2))
|
||||
|opAND: R[param1] := ORD(BITS(R[param1]) * BITS(R[param2]))
|
||||
|opANDC: R[param1] := ORD(BITS(R[param1]) * BITS(param2))
|
||||
|opOR: R[param1] := ORD(BITS(R[param1]) + BITS(R[param2]))
|
||||
|opORC: R[param1] := ORD(BITS(R[param1]) + BITS(param2))
|
||||
|opXOR: R[param1] := ORD(BITS(R[param1]) / BITS(R[param2]))
|
||||
|opXORC: R[param1] := ORD(BITS(R[param1]) / BITS(param2))
|
||||
|opASR: R[param1] := ASR(R[param1], R[param2])
|
||||
|opASRC: R[param1] := ASR(R[param1], param2)
|
||||
|opLSR: R[param1] := LSR(R[param1], R[param2])
|
||||
|opLSRC: R[param1] := LSR(R[param1], param2)
|
||||
|opLSL: R[param1] := LSL(R[param1], R[param2])
|
||||
|opLSLC: R[param1] := LSL(R[param1], param2)
|
||||
|opROR: R[param1] := ROR(R[param1], R[param2])
|
||||
|opRORC: R[param1] := ROR(R[param1], param2)
|
||||
|opMIN: R[param1] := MIN(R[param1], R[param2])
|
||||
|opMINC: R[param1] := MIN(R[param1], param2)
|
||||
|opMAX: R[param1] := MAX(R[param1], R[param2])
|
||||
|opMAXC: R[param1] := MAX(R[param1], param2)
|
||||
|opEQ: R[param1] := ORD(R[param1] = R[param2])
|
||||
|opEQC: R[param1] := ORD(R[param1] = param2)
|
||||
|opNE: R[param1] := ORD(R[param1] # R[param2])
|
||||
|opNEC: R[param1] := ORD(R[param1] # param2)
|
||||
|opLT: R[param1] := ORD(R[param1] < R[param2])
|
||||
|opLTC: R[param1] := ORD(R[param1] < param2)
|
||||
|opLE: R[param1] := ORD(R[param1] <= R[param2])
|
||||
|opLEC: R[param1] := ORD(R[param1] <= param2)
|
||||
|opGT: R[param1] := ORD(R[param1] > R[param2])
|
||||
|opGTC: R[param1] := ORD(R[param1] > param2)
|
||||
|opGE: R[param1] := ORD(R[param1] >= R[param2])
|
||||
|opGEC: R[param1] := ORD(R[param1] >= param2)
|
||||
|opBT: R[param1] := ORD((R[param1] < R[param2]) & (R[param1] >= 0))
|
||||
|opBTC: R[param1] := ORD((R[param1] < param2) & (R[param1] >= 0))
|
||||
|opLEA: R[param1 MOD 256] := Sections[param1 DIV 256].address + param2
|
||||
|opLABEL:
|
||||
|opSYSCALL: syscall(R[param1])
|
||||
END;
|
||||
cmd := cmd.next
|
||||
END
|
||||
END exec;
|
||||
|
||||
|
||||
PROCEDURE disasm (name: ARRAY OF CHAR; t_count, c_count, glob, heap: INTEGER);
|
||||
VAR
|
||||
cmd: COMMAND;
|
||||
param1, param2, i, t, ptr: INTEGER;
|
||||
b: BYTE;
|
||||
|
||||
|
||||
PROCEDURE String (s: ARRAY OF CHAR);
|
||||
VAR
|
||||
n: INTEGER;
|
||||
|
||||
BEGIN
|
||||
n := LENGTH(s);
|
||||
IF n > LEN(buf) - cnt THEN
|
||||
ASSERT(File.Write(F, SYSTEM.ADR(buf[0]), cnt) = cnt);
|
||||
cnt := 0
|
||||
END;
|
||||
SYSTEM.MOVE(SYSTEM.ADR(s[0]), SYSTEM.ADR(buf[0]) + cnt, n);
|
||||
INC(cnt, n)
|
||||
END String;
|
||||
|
||||
|
||||
PROCEDURE Ln;
|
||||
BEGIN
|
||||
String(0DX + 0AX)
|
||||
END Ln;
|
||||
|
||||
|
||||
PROCEDURE hexdgt (n: INTEGER): CHAR;
|
||||
BEGIN
|
||||
IF n < 10 THEN
|
||||
INC(n, ORD("0"))
|
||||
ELSE
|
||||
INC(n, ORD("A") - 10)
|
||||
END
|
||||
|
||||
RETURN CHR(n)
|
||||
END hexdgt;
|
||||
|
||||
|
||||
PROCEDURE Hex (x: INTEGER);
|
||||
VAR
|
||||
str: ARRAY 11 OF CHAR;
|
||||
n: INTEGER;
|
||||
|
||||
BEGIN
|
||||
n := 10;
|
||||
str[10] := 0X;
|
||||
WHILE n > 2 DO
|
||||
str[n - 1] := hexdgt(x MOD 16);
|
||||
x := x DIV 16;
|
||||
DEC(n)
|
||||
END;
|
||||
str[1] := "x";
|
||||
str[0] := "0";
|
||||
String(str)
|
||||
END Hex;
|
||||
|
||||
|
||||
PROCEDURE Byte (x: BYTE);
|
||||
VAR
|
||||
str: ARRAY 5 OF CHAR;
|
||||
|
||||
BEGIN
|
||||
str[4] := 0X;
|
||||
str[3] := hexdgt(x MOD 16);
|
||||
str[2] := hexdgt(x DIV 16);
|
||||
str[1] := "x";
|
||||
str[0] := "0";
|
||||
String(str)
|
||||
END Byte;
|
||||
|
||||
|
||||
PROCEDURE Reg (n: INTEGER);
|
||||
VAR
|
||||
s: ARRAY 2 OF CHAR;
|
||||
BEGIN
|
||||
IF n = BP THEN
|
||||
String("BP")
|
||||
ELSIF n = SP THEN
|
||||
String("SP")
|
||||
ELSE
|
||||
String("R");
|
||||
s[1] := 0X;
|
||||
IF n >= 10 THEN
|
||||
s[0] := CHR(n DIV 10 + ORD("0"));
|
||||
String(s)
|
||||
END;
|
||||
s[0] := CHR(n MOD 10 + ORD("0"));
|
||||
String(s)
|
||||
END
|
||||
END Reg;
|
||||
|
||||
|
||||
PROCEDURE Reg2 (r1, r2: INTEGER);
|
||||
BEGIN
|
||||
Reg(r1); String(", "); Reg(r2)
|
||||
END Reg2;
|
||||
|
||||
|
||||
PROCEDURE RegC (r, c: INTEGER);
|
||||
BEGIN
|
||||
Reg(r); String(", "); Hex(c)
|
||||
END RegC;
|
||||
|
||||
|
||||
PROCEDURE RegL (r, label: INTEGER);
|
||||
BEGIN
|
||||
Reg(r); String(", L"); Hex(label)
|
||||
END RegL;
|
||||
|
||||
|
||||
BEGIN
|
||||
Sections[Types].name := "TYPES";
|
||||
Sections[Strings].name := "STRINGS";
|
||||
Sections[Global].name := "GLOBAL";
|
||||
Sections[Heap].name := "HEAP";
|
||||
Sections[Stack].name := "STACK";
|
||||
|
||||
F := File.Create(name);
|
||||
ASSERT(F > 0);
|
||||
cnt := 0;
|
||||
String("CODE:"); Ln;
|
||||
cmd := first;
|
||||
WHILE cmd # NIL DO
|
||||
param1 := cmd.param1;
|
||||
param2 := cmd.param2;
|
||||
CASE cmd.op OF
|
||||
|opSTOP: String("STOP")
|
||||
|opRET: String("RET")
|
||||
|opENTER: String("ENTER "); Hex(param1)
|
||||
|opPOP: String("POP "); Reg(param1)
|
||||
|opNEG: String("NEG "); Reg(param1)
|
||||
|opNOT: String("NOT "); Reg(param1)
|
||||
|opABS: String("ABS "); Reg(param1)
|
||||
|opXCHG: String("XCHG "); Reg2(param1, param2)
|
||||
|opLDR8: String("LDR8 "); Reg2(param1, param2)
|
||||
|opLDR16: String("LDR16 "); Reg2(param1, param2)
|
||||
|opLDR32: String("LDR32 "); Reg2(param1, param2)
|
||||
|opPUSH: String("PUSH "); Reg(param1)
|
||||
|opPUSHC: String("PUSH "); Hex(param1)
|
||||
|opJGZ: String("JGZ "); RegL(param1, param2)
|
||||
|opJZ: String("JZ "); RegL(param1, param2)
|
||||
|opJNZ: String("JNZ "); RegL(param1, param2)
|
||||
|opLLA: String("LLA "); RegL(param1, param2)
|
||||
|opJGA: String("JGA "); Hex(param1); String(", L"); Hex(param2)
|
||||
|opJLA: String("JLA "); Hex(param1); String(", L"); Hex(param2)
|
||||
|opJMP: String("JMP L"); Hex(param1)
|
||||
|opCALL: String("CALL L"); Hex(param1)
|
||||
|opCALLI: String("CALL "); Reg(param1)
|
||||
|opMOV: String("MOV "); Reg2(param1, param2)
|
||||
|opMOVC: String("MOV "); RegC(param1, param2)
|
||||
|opMUL: String("MUL "); Reg2(param1, param2)
|
||||
|opMULC: String("MUL "); RegC(param1, param2)
|
||||
|opADD: String("ADD "); Reg2(param1, param2)
|
||||
|opADDC: String("ADD "); RegC(param1, param2)
|
||||
|opSUB: String("SUB "); Reg2(param1, param2)
|
||||
|opSUBC: String("SUB "); RegC(param1, param2)
|
||||
|opDIV: String("DIV "); Reg2(param1, param2)
|
||||
|opDIVC: String("DIV "); RegC(param1, param2)
|
||||
|opMOD: String("MOD "); Reg2(param1, param2)
|
||||
|opMODC: String("MOD "); RegC(param1, param2)
|
||||
|opSTR8: String("STR8 "); Reg2(param1, param2)
|
||||
|opSTR8C: String("STR8 "); RegC(param1, param2)
|
||||
|opSTR16: String("STR16 "); Reg2(param1, param2)
|
||||
|opSTR16C: String("STR16 "); RegC(param1, param2)
|
||||
|opSTR32: String("STR32 "); Reg2(param1, param2)
|
||||
|opSTR32C: String("STR32 "); RegC(param1, param2)
|
||||
|opINCL: String("INCL "); Reg2(param1, param2)
|
||||
|opINCLC: String("INCL "); RegC(param1, param2)
|
||||
|opEXCL: String("EXCL "); Reg2(param1, param2)
|
||||
|opEXCLC: String("EXCL "); RegC(param1, param2)
|
||||
|opIN: String("IN "); Reg2(param1, param2)
|
||||
|opINC: String("IN "); RegC(param1, param2)
|
||||
|opAND: String("AND "); Reg2(param1, param2)
|
||||
|opANDC: String("AND "); RegC(param1, param2)
|
||||
|opOR: String("OR "); Reg2(param1, param2)
|
||||
|opORC: String("OR "); RegC(param1, param2)
|
||||
|opXOR: String("XOR "); Reg2(param1, param2)
|
||||
|opXORC: String("XOR "); RegC(param1, param2)
|
||||
|opASR: String("ASR "); Reg2(param1, param2)
|
||||
|opASRC: String("ASR "); RegC(param1, param2)
|
||||
|opLSR: String("LSR "); Reg2(param1, param2)
|
||||
|opLSRC: String("LSR "); RegC(param1, param2)
|
||||
|opLSL: String("LSL "); Reg2(param1, param2)
|
||||
|opLSLC: String("LSL "); RegC(param1, param2)
|
||||
|opROR: String("ROR "); Reg2(param1, param2)
|
||||
|opRORC: String("ROR "); RegC(param1, param2)
|
||||
|opMIN: String("MIN "); Reg2(param1, param2)
|
||||
|opMINC: String("MIN "); RegC(param1, param2)
|
||||
|opMAX: String("MAX "); Reg2(param1, param2)
|
||||
|opMAXC: String("MAX "); RegC(param1, param2)
|
||||
|opEQ: String("EQ "); Reg2(param1, param2)
|
||||
|opEQC: String("EQ "); RegC(param1, param2)
|
||||
|opNE: String("NE "); Reg2(param1, param2)
|
||||
|opNEC: String("NE "); RegC(param1, param2)
|
||||
|opLT: String("LT "); Reg2(param1, param2)
|
||||
|opLTC: String("LT "); RegC(param1, param2)
|
||||
|opLE: String("LE "); Reg2(param1, param2)
|
||||
|opLEC: String("LE "); RegC(param1, param2)
|
||||
|opGT: String("GT "); Reg2(param1, param2)
|
||||
|opGTC: String("GT "); RegC(param1, param2)
|
||||
|opGE: String("GE "); Reg2(param1, param2)
|
||||
|opGEC: String("GE "); RegC(param1, param2)
|
||||
|opBT: String("BT "); Reg2(param1, param2)
|
||||
|opBTC: String("BT "); RegC(param1, param2)
|
||||
|opLEA: String("LEA "); Reg(param1 MOD 256); String(", "); String(Sections[param1 DIV 256].name); String(" + "); Hex(param2)
|
||||
|opLABEL: String("L"); Hex(param1); String(":")
|
||||
|opSYSCALL: String("SYSCALL "); Reg(param1)
|
||||
END;
|
||||
Ln;
|
||||
cmd := cmd.next
|
||||
END;
|
||||
|
||||
String("TYPES:");
|
||||
ptr := Sections[Types].address;
|
||||
FOR i := 0 TO t_count - 1 DO
|
||||
IF i MOD 4 = 0 THEN
|
||||
Ln; String("WORD ")
|
||||
ELSE
|
||||
String(", ")
|
||||
END;
|
||||
SYSTEM.GET32(ptr, t); INC(ptr, 4);
|
||||
Hex(t)
|
||||
END;
|
||||
Ln;
|
||||
|
||||
String("STRINGS:");
|
||||
ptr := Sections[Strings].address;
|
||||
FOR i := 0 TO c_count - 1 DO
|
||||
IF i MOD 8 = 0 THEN
|
||||
Ln; String("BYTE ")
|
||||
ELSE
|
||||
String(", ")
|
||||
END;
|
||||
SYSTEM.GET8(ptr, b); INC(ptr);
|
||||
Byte(b)
|
||||
END;
|
||||
Ln;
|
||||
|
||||
String("GLOBAL:"); Ln;
|
||||
String("WORDS "); Hex(glob); Ln;
|
||||
String("HEAP:"); Ln;
|
||||
String("WORDS "); Hex(heap); Ln;
|
||||
String("STACK:"); Ln;
|
||||
String("WORDS 8"); Ln;
|
||||
|
||||
ASSERT(File.Write(F, SYSTEM.ADR(buf[0]), cnt) = cnt);
|
||||
File.Close(F)
|
||||
END disasm;
|
||||
|
||||
|
||||
PROCEDURE GetCommand (adr: INTEGER): COMMAND;
|
||||
VAR
|
||||
op, param1, param2: INTEGER;
|
||||
res: COMMAND;
|
||||
|
||||
BEGIN
|
||||
op := 0; param1 := 0; param2 := 0;
|
||||
SYSTEM.GET32(adr, op);
|
||||
SYSTEM.GET32(adr + 4, param1);
|
||||
SYSTEM.GET32(adr + 8, param2);
|
||||
NEW(res);
|
||||
res.op := op;
|
||||
res.param1 := param1;
|
||||
res.param2 := param2;
|
||||
res.next := NIL
|
||||
|
||||
RETURN res
|
||||
END GetCommand;
|
||||
|
||||
|
||||
PROCEDURE main;
|
||||
VAR
|
||||
name, param: ARRAY 1024 OF CHAR;
|
||||
cmd: COMMAND;
|
||||
file, fsize, n: INTEGER;
|
||||
|
||||
descr: ARRAY 12 OF INTEGER;
|
||||
|
||||
offTypes, offStrings, GlobalSize, HeapStackSize, DescrSize: INTEGER;
|
||||
|
||||
BEGIN
|
||||
Out.Open;
|
||||
Args.GetArg(1, name);
|
||||
F := File.Open(name, File.OPEN_R);
|
||||
IF F > 0 THEN
|
||||
DescrSize := LEN(descr) * SYSTEM.SIZE(INTEGER);
|
||||
fsize := File.Seek(F, 0, File.SEEK_END);
|
||||
ASSERT(fsize > DescrSize);
|
||||
file := API._NEW(fsize);
|
||||
ASSERT(file # 0);
|
||||
n := File.Seek(F, 0, File.SEEK_BEG);
|
||||
ASSERT(fsize = File.Read(F, file, fsize));
|
||||
File.Close(F);
|
||||
|
||||
SYSTEM.MOVE(file + fsize - DescrSize, SYSTEM.ADR(descr[0]), DescrSize);
|
||||
offTypes := descr[0];
|
||||
ASSERT(offTypes < fsize - DescrSize);
|
||||
ASSERT(offTypes > 0);
|
||||
ASSERT(offTypes MOD 12 = 0);
|
||||
offStrings := descr[1];
|
||||
ASSERT(offStrings < fsize - DescrSize);
|
||||
ASSERT(offStrings > 0);
|
||||
ASSERT(offStrings MOD 4 = 0);
|
||||
ASSERT(offStrings > offTypes);
|
||||
GlobalSize := descr[2];
|
||||
ASSERT(GlobalSize > 0);
|
||||
HeapStackSize := descr[3];
|
||||
ASSERT(HeapStackSize > 0);
|
||||
|
||||
Sections[Types].address := API._NEW(offStrings - offTypes);
|
||||
ASSERT(Sections[Types].address # 0);
|
||||
SYSTEM.MOVE(file + offTypes, Sections[Types].address, offStrings - offTypes);
|
||||
|
||||
Sections[Strings].address := API._NEW(fsize - offStrings - DescrSize);
|
||||
ASSERT(Sections[Strings].address # 0);
|
||||
SYSTEM.MOVE(file + offStrings, Sections[Strings].address, fsize - offStrings - DescrSize);
|
||||
|
||||
Sections[Global].address := API._NEW(GlobalSize * 4);
|
||||
ASSERT(Sections[Global].address # 0);
|
||||
|
||||
Sections[Heap].address := API._NEW(HeapStackSize * 4);
|
||||
ASSERT(Sections[Heap].address # 0);
|
||||
|
||||
Sections[Stack].address := Sections[Heap].address + HeapStackSize * 4 - 32;
|
||||
|
||||
n := offTypes DIV 12;
|
||||
first := GetCommand(file + offTypes - n * 12);
|
||||
last := first;
|
||||
DEC(n);
|
||||
WHILE n > 0 DO
|
||||
cmd := GetCommand(file + offTypes - n * 12);
|
||||
IF cmd.op = opLABEL THEN
|
||||
Labels[cmd.param1] := cmd
|
||||
END;
|
||||
last.next := cmd;
|
||||
last := cmd;
|
||||
DEC(n)
|
||||
END;
|
||||
file := API._DISPOSE(file);
|
||||
Args.GetArg(2, param);
|
||||
IF param = "-dis" THEN
|
||||
Args.GetArg(3, name);
|
||||
IF name # "" THEN
|
||||
disasm(name, (offStrings - offTypes) DIV 4, fsize - offStrings - DescrSize, GlobalSize, HeapStackSize)
|
||||
END
|
||||
ELSIF param = "-run" THEN
|
||||
exec
|
||||
END
|
||||
ELSE
|
||||
Out.String("file not found"); Out.Ln
|
||||
END
|
||||
END main;
|
||||
|
||||
|
||||
BEGIN
|
||||
ASSERT(RTL.bit_depth = 32);
|
||||
main
|
||||
END RVM32I.
|
||||
Reference in new issue
Block a user