diff --git a/Compiler b/Compiler index 9d7c5ca..8bf7570 100644 Binary files a/Compiler and b/Compiler differ diff --git a/Compiler.exe b/Compiler.exe index 5dad423..c672110 100644 Binary files a/Compiler.exe and b/Compiler.exe differ diff --git a/lib/KolibriOS/RTL.ob07 b/lib/KolibriOS/RTL.ob07 index 3f82c07..dd2fe9d 100644 --- a/lib/KolibriOS/RTL.ob07 +++ b/lib/KolibriOS/RTL.ob07 @@ -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); diff --git a/lib/Linux32/RTL.ob07 b/lib/Linux32/RTL.ob07 index 3f82c07..dd2fe9d 100644 --- a/lib/Linux32/RTL.ob07 +++ b/lib/Linux32/RTL.ob07 @@ -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); diff --git a/lib/Linux64/RTL.ob07 b/lib/Linux64/RTL.ob07 index 8e3c707..a8027ca 100644 --- a/lib/Linux64/RTL.ob07 +++ b/lib/Linux64/RTL.ob07 @@ -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); diff --git a/lib/RVM32I/FPU.ob07 b/lib/RVM32I/FPU.ob07 new file mode 100644 index 0000000..2e3391a --- /dev/null +++ b/lib/RVM32I/FPU.ob07 @@ -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. \ No newline at end of file diff --git a/lib/RVM32I/HOST.ob07 b/lib/RVM32I/HOST.ob07 new file mode 100644 index 0000000..380b75c --- /dev/null +++ b/lib/RVM32I/HOST.ob07 @@ -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. \ No newline at end of file diff --git a/lib/RVM32I/Out.ob07 b/lib/RVM32I/Out.ob07 new file mode 100644 index 0000000..b5264da --- /dev/null +++ b/lib/RVM32I/Out.ob07 @@ -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. \ No newline at end of file diff --git a/lib/RVM32I/RTL.ob07 b/lib/RVM32I/RTL.ob07 new file mode 100644 index 0000000..7fcb656 --- /dev/null +++ b/lib/RVM32I/RTL.ob07 @@ -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. \ No newline at end of file diff --git a/lib/RVM32I/Trap.ob07 b/lib/RVM32I/Trap.ob07 new file mode 100644 index 0000000..fcb76d1 --- /dev/null +++ b/lib/RVM32I/Trap.ob07 @@ -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. \ No newline at end of file diff --git a/lib/STM32CM3/RTL.ob07 b/lib/STM32CM3/RTL.ob07 index 6f62dba..d434b47 100644 --- a/lib/STM32CM3/RTL.ob07 +++ b/lib/STM32CM3/RTL.ob07 @@ -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); diff --git a/lib/Windows32/RTL.ob07 b/lib/Windows32/RTL.ob07 index 3f82c07..dd2fe9d 100644 --- a/lib/Windows32/RTL.ob07 +++ b/lib/Windows32/RTL.ob07 @@ -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); diff --git a/lib/Windows64/RTL.ob07 b/lib/Windows64/RTL.ob07 index 8e3c707..a8027ca 100644 --- a/lib/Windows64/RTL.ob07 +++ b/lib/Windows64/RTL.ob07 @@ -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); diff --git a/source/ERRORS.ob07 b/source/ERRORS.ob07 index a64fa62..0aa75d3 100644 --- a/source/ERRORS.ob07 +++ b/source/ERRORS.ob07 @@ -211,6 +211,7 @@ BEGIN |205: Error1("not enough parameters") |206: Error1("bad parameter ") |207: Error3('inputfile name extension must be "', UTILS.FILE_EXT, '"') + |208: Error1("not enough RAM") END END Error; diff --git a/source/RVM32I.ob07 b/source/RVM32I.ob07 new file mode 100644 index 0000000..5459957 --- /dev/null +++ b/source/RVM32I.ob07 @@ -0,0 +1,1315 @@ +(* + BSD 2-Clause License + + Copyright (c) 2020, Anton Krotov + All rights reserved. +*) + +MODULE RVM32I; + +IMPORT + + PROG, WR := WRITER, IL, CHL := CHUNKLISTS, + REG, C := CONSOLE, UTILS, STRINGS, ERRORS; + + +CONST + + LTypes = 0; + LStrings = 1; + LGlobal = 2; + LHeap = 3; + LStack = 4; + + numGPRs = 3; + + R0 = 0; R1 = 1; + BP = 3; SP = 4; + + ACC = R0; + + GPRs = {0 .. 2} + {5 .. numGPRs + 1}; + + 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; + + inf = 7F800000H; + + +VAR + + R: REG.REGS; count: INTEGER; + + +PROCEDURE OutByte (n: BYTE); +BEGIN + WR.WriteByte(n); + INC(count) +END OutByte; + + +PROCEDURE OutInt (n: INTEGER); +BEGIN + WR.Write32LE(n); + INC(count, 4) +END OutInt; + + +PROCEDURE Emit (op, par1, par2: INTEGER); +BEGIN + OutInt(op); + OutInt(par1); + OutInt(par2) +END Emit; + + +PROCEDURE drop; +BEGIN + REG.Drop(R) +END drop; + + +PROCEDURE GetAnyReg (): INTEGER; + RETURN REG.GetAnyReg(R) +END GetAnyReg; + + +PROCEDURE GetAcc; +BEGIN + ASSERT(REG.GetReg(R, ACC)) +END GetAcc; + + +PROCEDURE UnOp (VAR r: INTEGER); +BEGIN + REG.UnOp(R, r) +END UnOp; + + +PROCEDURE BinOp (VAR r1, r2: INTEGER); +BEGIN + REG.BinOp(R, r1, r2) +END BinOp; + + +PROCEDURE PushAll (NumberOfParameters: INTEGER); +BEGIN + REG.PushAll(R); + DEC(R.pushed, NumberOfParameters) +END PushAll; + + +PROCEDURE push (r: INTEGER); +BEGIN + Emit(opPUSH, r, 0) +END push; + + +PROCEDURE pop (r: INTEGER); +BEGIN + Emit(opPOP, r, 0) +END pop; + + +PROCEDURE mov (r1, r2: INTEGER); +BEGIN + Emit(opMOV, r1, r2) +END mov; + + +PROCEDURE xchg (r1, r2: INTEGER); +BEGIN + Emit(opXCHG, r1, r2) +END xchg; + + +PROCEDURE addrc (r, c: INTEGER); +BEGIN + Emit(opADDC, r, c) +END addrc; + + +PROCEDURE subrc (r, c: INTEGER); +BEGIN + Emit(opSUBC, r, c) +END subrc; + + +PROCEDURE movrc (r, c: INTEGER); +BEGIN + Emit(opMOVC, r, c) +END movrc; + + +PROCEDURE pushc (c: INTEGER); +BEGIN + Emit(opPUSHC, c, 0) +END pushc; + + +PROCEDURE add (r1, r2: INTEGER); +BEGIN + Emit(opADD, r1, r2) +END add; + + +PROCEDURE sub (r1, r2: INTEGER); +BEGIN + Emit(opSUB, r1, r2) +END sub; + + +PROCEDURE ldr32 (r1, r2: INTEGER); +BEGIN + Emit(opLDR32, r1, r2) +END ldr32; + + +PROCEDURE ldr16 (r1, r2: INTEGER); +BEGIN + Emit(opLDR16, r1, r2) +END ldr16; + + +PROCEDURE ldr8 (r1, r2: INTEGER); +BEGIN + Emit(opLDR8, r1, r2) +END ldr8; + + +PROCEDURE str32 (r1, r2: INTEGER); +BEGIN + Emit(opSTR32, r1, r2) +END str32; + + +PROCEDURE str16 (r1, r2: INTEGER); +BEGIN + Emit(opSTR16, r1, r2) +END str16; + + +PROCEDURE str8 (r1, r2: INTEGER); +BEGIN + Emit(opSTR8, r1, r2) +END str8; + + +PROCEDURE GlobalAdr (r, offset: INTEGER); +BEGIN + Emit(opLEA, r + 256 * LGlobal, offset) +END GlobalAdr; + + +PROCEDURE StrAdr (r, offset: INTEGER); +BEGIN + Emit(opLEA, r + 256 * LStrings, offset) +END StrAdr; + + +PROCEDURE ProcAdr (r, label: INTEGER); +BEGIN + Emit(opLLA, r, label) +END ProcAdr; + + +PROCEDURE jnz (r, label: INTEGER); +BEGIN + Emit(opJNZ, r, label) +END jnz; + + +PROCEDURE CallRTL (proc, par: INTEGER); +BEGIN + Emit(opCALL, IL.codes.rtl[proc], 0); + addrc(SP, par * 4) +END CallRTL; + + +PROCEDURE translate; +VAR + cmd: IL.COMMAND; + opcode, param1, param2: INTEGER; + r1, r2, r3: INTEGER; + +BEGIN + cmd := IL.codes.commands.first(IL.COMMAND); + + WHILE cmd # NIL DO + + param1 := cmd.param1; + param2 := cmd.param2; + opcode := cmd.opcode; + + CASE opcode OF + + |IL.opJMP: + Emit(opJMP, param1, 0) + + |IL.opLABEL: + Emit(opLABEL, param1, 0) + + |IL.opCALL: + Emit(opCALL, param1, 0) + + |IL.opCALLP: + UnOp(r1); + Emit(opCALLI, r1, 0); + drop; + ASSERT(R.top = -1) + + |IL.opPUSHC: + pushc(param2) + + |IL.opCLEANUP: + IF param2 # 0 THEN + addrc(SP, param2 * 4) + END + + |IL.opNOP: + + |IL.opSADR: + StrAdr(GetAnyReg(), param2) + + |IL.opGADR: + GlobalAdr(GetAnyReg(), param2) + + |IL.opLADR: + r1 := GetAnyReg(); + mov(r1, BP); + addrc(r1, param2 * 4) + + |IL.opPARAM: + IF param2 = 1 THEN + UnOp(r1); + push(r1); + drop + ELSE + ASSERT(R.top + 1 <= param2); + PushAll(param2) + END + + |IL.opONERR: + pushc(param2); + Emit(opJMP, param1, 0) + + |IL.opPRECALL: + PushAll(0) + + |IL.opRES, IL.opRESF: + ASSERT(R.top = -1); + GetAcc + + |IL.opENTER: + ASSERT(R.top = -1); + Emit(opLABEL, param1, 0); + Emit(opENTER, param2, 0) + + |IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF: + IF opcode # IL.opLEAVE THEN + UnOp(r1); + IF r1 # ACC THEN + GetAcc; + ASSERT(REG.Exchange(R, r1, ACC)); + drop + END; + drop + END; + + ASSERT(R.top = -1); + + IF param1 > 0 THEN + mov(SP, BP) + END; + + pop(BP); + + Emit(opRET, 0, 0) + + |IL.opLEAVEC: + Emit(opRET, 0, 0) + + |IL.opCONST: + movrc(GetAnyReg(), param2) + + |IL.opDROP: + UnOp(r1); + drop + + |IL.opACC: + IF (R.top # 0) OR (R.stk[0] # ACC) THEN + PushAll(0); + GetAcc; + pop(ACC); + DEC(R.pushed) + END + + |IL.opSAVEC: + UnOp(r1); + Emit(opSTR32C, r1, param2); + drop + + |IL.opSAVE8C: + UnOp(r1); + Emit(opSTR8C, r1, param2 MOD 256); + drop + + |IL.opSAVE16C: + UnOp(r1); + Emit(opSTR16C, r1, param2 MOD 65536); + drop + + |IL.opSAVE, IL.opSAVE32, IL.opSAVEF: + BinOp(r2, r1); + str32(r1, r2); + drop; + drop + + |IL.opSAVEFI: + BinOp(r2, r1); + str32(r2, r1); + drop; + drop + + |IL.opSAVE8: + BinOp(r2, r1); + str8(r1, r2); + drop; + drop + + |IL.opSAVE16: + BinOp(r2, r1); + str16(r1, r2); + drop; + drop + + |IL.opGLOAD32: + r1 := GetAnyReg(); + GlobalAdr(r1, param2); + ldr32(r1, r1) + + |IL.opVADR, IL.opLLOAD32: + r1 := GetAnyReg(); + mov(r1, BP); + addrc(r1, param2 * 4); + ldr32(r1, r1) + + |IL.opVLOAD32: + r1 := GetAnyReg(); + mov(r1, BP); + addrc(r1, param2 * 4); + ldr32(r1, r1); + ldr32(r1, r1) + + |IL.opGLOAD16: + r1 := GetAnyReg(); + GlobalAdr(r1, param2); + ldr16(r1, r1) + + |IL.opLLOAD16: + r1 := GetAnyReg(); + mov(r1, BP); + addrc(r1, param2 * 4); + ldr16(r1, r1) + + |IL.opVLOAD16: + r1 := GetAnyReg(); + mov(r1, BP); + addrc(r1, param2 * 4); + ldr32(r1, r1); + ldr16(r1, r1) + + |IL.opGLOAD8: + r1 := GetAnyReg(); + GlobalAdr(r1, param2); + ldr8(r1, r1) + + |IL.opLLOAD8: + r1 := GetAnyReg(); + mov(r1, BP); + addrc(r1, param2 * 4); + ldr8(r1, r1) + + |IL.opVLOAD8: + r1 := GetAnyReg(); + mov(r1, BP); + addrc(r1, param2 * 4); + ldr32(r1, r1); + ldr8(r1, r1) + + |IL.opLOAD8: + UnOp(r1); + ldr8(r1, r1) + + |IL.opLOAD16: + UnOp(r1); + ldr16(r1, r1) + + |IL.opLOAD32, IL.opLOADF: + UnOp(r1); + ldr32(r1, r1) + + |IL.opLOOP, IL.opENDLOOP: + + |IL.opUMINUS: + UnOp(r1); + Emit(opNEG, r1, 0) + + |IL.opADD: + BinOp(r1, r2); + add(r1, r2); + drop + + |IL.opSUB: + BinOp(r1, r2); + sub(r1, r2); + drop + + |IL.opADDC: + UnOp(r1); + addrc(r1, param2) + + |IL.opSUBR: + UnOp(r1); + subrc(r1, param2) + + |IL.opSUBL: + UnOp(r1); + subrc(r1, param2); + Emit(opNEG, r1, 0) + + |IL.opMULC: + UnOp(r1); + Emit(opMULC, r1, param2) + + |IL.opMUL: + BinOp(r1, r2); + Emit(opMUL, r1, r2); + drop + + |IL.opDIV: + BinOp(r1, r2); + Emit(opDIV, r1, r2); + drop + + |IL.opMOD: + BinOp(r1, r2); + Emit(opMOD, r1, r2); + drop + + |IL.opDIVR: + UnOp(r1); + Emit(opDIVC, r1, param2) + + |IL.opMODR: + UnOp(r1); + Emit(opMODC, r1, param2) + + |IL.opDIVL: + UnOp(r1); + r2 := GetAnyReg(); + movrc(r2, param2); + Emit(opDIV, r2, r1); + mov(r1, r2); + drop + + |IL.opMODL: + UnOp(r1); + r2 := GetAnyReg(); + movrc(r2, param2); + Emit(opMOD, r2, r1); + mov(r1, r2); + drop + + |IL.opEQ: + BinOp(r1, r2); + Emit(opEQ, r1, r2); + drop + + |IL.opNE: + BinOp(r1, r2); + Emit(opNE, r1, r2); + drop + + |IL.opLT: + BinOp(r1, r2); + Emit(opLT, r1, r2); + drop + + |IL.opLE: + BinOp(r1, r2); + Emit(opLE, r1, r2); + drop + + |IL.opGT: + BinOp(r1, r2); + Emit(opGT, r1, r2); + drop + + |IL.opGE: + BinOp(r1, r2); + Emit(opGE, r1, r2); + drop + + |IL.opEQC: + UnOp(r1); + Emit(opEQC, r1, param2) + + |IL.opNEC: + UnOp(r1); + Emit(opNEC, r1, param2) + + |IL.opLTC: + UnOp(r1); + Emit(opLTC, r1, param2) + + |IL.opLEC: + UnOp(r1); + Emit(opLEC, r1, param2) + + |IL.opGTC: + UnOp(r1); + Emit(opGTC, r1, param2) + + |IL.opGEC: + UnOp(r1); + Emit(opGEC, r1, param2) + + |IL.opJNZ: + UnOp(r1); + jnz(r1, param1) + + |IL.opJZ: + UnOp(r1); + Emit(opJZ, r1, param1) + + |IL.opJG: + UnOp(r1); + Emit(opJGZ, r1, param1) + + |IL.opJE: + UnOp(r1); + jnz(r1, param1); + drop + + |IL.opJNE: + UnOp(r1); + Emit(opJZ, r1, param1); + drop + + |IL.opMULS: + BinOp(r1, r2); + Emit(opAND, r1, r2); + drop + + |IL.opMULSC: + UnOp(r1); + Emit(opANDC, r1, param2) + + |IL.opDIVS: + BinOp(r1, r2); + Emit(opXOR, r1, r2); + drop + + |IL.opDIVSC: + UnOp(r1); + Emit(opXORC, r1, param2) + + |IL.opADDS: + BinOp(r1, r2); + Emit(opOR, r1, r2); + drop + + |IL.opSUBS: + BinOp(r1, r2); + Emit(opNOT, r2, 0); + Emit(opAND, r1, r2); + drop + + |IL.opADDSC: + UnOp(r1); + Emit(opORC, r1, param2) + + |IL.opSUBSL: + UnOp(r1); + Emit(opNOT, r1, 0); + Emit(opANDC, r1, param2) + + |IL.opSUBSR: + UnOp(r1); + Emit(opANDC, r1, ORD(-BITS(param2))) + + |IL.opUMINS: + UnOp(r1); + Emit(opNOT, r1, 0) + + |IL.opASR: + BinOp(r1, r2); + Emit(opASR, r1, r2); + drop + + |IL.opLSL: + BinOp(r1, r2); + Emit(opLSL, r1, r2); + drop + + |IL.opROR: + BinOp(r1, r2); + Emit(opROR, r1, r2); + drop + + |IL.opLSR: + BinOp(r1, r2); + Emit(opLSR, r1, r2); + drop + + |IL.opASR1: + r2 := GetAnyReg(); + Emit(opMOVC, r2, param2); + BinOp(r1, r2); + Emit(opASR, r2, r1); + mov(r1, r2); + drop + + |IL.opLSL1: + r2 := GetAnyReg(); + Emit(opMOVC, r2, param2); + BinOp(r1, r2); + Emit(opLSL, r2, r1); + mov(r1, r2); + drop + + |IL.opROR1: + r2 := GetAnyReg(); + Emit(opMOVC, r2, param2); + BinOp(r1, r2); + Emit(opROR, r2, r1); + mov(r1, r2); + drop + + |IL.opLSR1: + r2 := GetAnyReg(); + Emit(opMOVC, r2, param2); + BinOp(r1, r2); + Emit(opLSR, r2, r1); + mov(r1, r2); + drop + + |IL.opASR2: + UnOp(r1); + Emit(opASRC, r1, param2 MOD 32) + + |IL.opLSL2: + UnOp(r1); + Emit(opLSLC, r1, param2 MOD 32) + + |IL.opROR2: + UnOp(r1); + Emit(opRORC, r1, param2 MOD 32) + + |IL.opLSR2: + UnOp(r1); + Emit(opLSRC, r1, param2 MOD 32) + + |IL.opCHR: + UnOp(r1); + Emit(opANDC, r1, 255) + + |IL.opWCHR: + UnOp(r1); + Emit(opANDC, r1, 65535) + + |IL.opABS: + UnOp(r1); + Emit(opABS, r1, 0) + + |IL.opLEN: + UnOp(r1); + drop; + EXCL(R.regs, r1); + + WHILE param2 > 0 DO + UnOp(r2); + drop; + DEC(param2) + END; + + INCL(R.regs, r1); + ASSERT(REG.GetReg(R, r1)) + + |IL.opSWITCH: + UnOp(r1); + IF param2 = 0 THEN + r2 := ACC + ELSE + r2 := R1 + END; + IF r1 # r2 THEN + ASSERT(REG.GetReg(R, r2)); + ASSERT(REG.Exchange(R, r1, r2)); + drop + END; + drop + + |IL.opENDSW: + + |IL.opCASEL: + GetAcc; + Emit(opJLA, param1, param2); + drop + + |IL.opCASER: + GetAcc; + Emit(opJGA, param1, param2); + drop + + |IL.opCASELR: + GetAcc; + Emit(opJLA, param1, param2); + Emit(opJGA, param1, cmd.param3); + drop + + |IL.opSBOOL: + BinOp(r2, r1); + Emit(opNEC, r2, 0); + str8(r1, r2); + drop; + drop + + |IL.opSBOOLC: + UnOp(r1); + Emit(opSTR8C, r1, ORD(param2 # 0)); + drop + + |IL.opINCC: + UnOp(r1); + r2 := GetAnyReg(); + ldr32(r2, r1); + addrc(r2, param2); + str32(r1, r2); + drop; + drop + + |IL.opINCCB, IL.opDECCB: + IF opcode = IL.opDECCB THEN + param2 := -param2 + END; + UnOp(r1); + r2 := GetAnyReg(); + ldr8(r2, r1); + addrc(r2, param2); + str8(r1, r2); + drop; + drop + + |IL.opINCB, IL.opDECB: + BinOp(r2, r1); + r3 := GetAnyReg(); + ldr8(r3, r1); + IF opcode = IL.opINCB THEN + add(r3, r2) + ELSE + sub(r3, r2) + END; + str8(r1, r3); + drop; + drop; + drop + + |IL.opINC, IL.opDEC: + BinOp(r2, r1); + r3 := GetAnyReg(); + ldr32(r3, r1); + IF opcode = IL.opINC THEN + add(r3, r2) + ELSE + sub(r3, r2) + END; + str32(r1, r3); + drop; + drop; + drop + + |IL.opINCL, IL.opEXCL: + BinOp(r2, r1); + IF opcode = IL.opINCL THEN + Emit(opINCL, r1, r2) + ELSE + Emit(opEXCL, r1, r2) + END; + drop; + drop + + |IL.opINCLC, IL.opEXCLC: + UnOp(r1); + r2 := GetAnyReg(); + ldr32(r2, r1); + IF opcode = IL.opINCLC THEN + Emit(opINCLC, r2, param2) + ELSE + Emit(opEXCLC, r2, param2) + END; + str32(r1, r2); + drop; + drop + + |IL.opEQB, IL.opNEB: + BinOp(r1, r2); + Emit(opNEC, r1, 0); + Emit(opNEC, r2, 0); + IF opcode = IL.opEQB THEN + Emit(opEQ, r1, r2) + ELSE + Emit(opNE, r1, r2) + END; + drop + + |IL.opCHKBYTE: + BinOp(r1, r2); + r3 := GetAnyReg(); + mov(r3, r1); + Emit(opBTC, r3, 256); + jnz(r3, param1); + drop + + |IL.opCHKIDX: + UnOp(r1); + r2 := GetAnyReg(); + mov(r2, r1); + Emit(opBTC, r2, param2); + jnz(r2, param1); + drop + + |IL.opCHKIDX2: + BinOp(r1, r2); + IF param2 # -1 THEN + r3 := GetAnyReg(); + mov(r3, r2); + Emit(opBT, r3, r1); + jnz(r3, param1); + drop + END; + INCL(R.regs, r1); + DEC(R.top); + R.stk[R.top] := r2 + + |IL.opEQP, IL.opNEP: + ProcAdr(GetAnyReg(), param1); + BinOp(r1, r2); + IF opcode = IL.opEQP THEN + Emit(opEQ, r1, r2) + ELSE + Emit(opNE, r1, r2) + END; + drop + + |IL.opSAVEP: + UnOp(r1); + r2 := GetAnyReg(); + ProcAdr(r2, param2); + str32(r1, r2); + drop; + drop + + |IL.opPUSHP: + ProcAdr(GetAnyReg(), param2) + + |IL.opPUSHT: + UnOp(r1); + r2 := GetAnyReg(); + mov(r2, r1); + subrc(r2, 4); + ldr32(r2, r2) + + |IL.opGET, IL.opGETC: + IF opcode = IL.opGET THEN + BinOp(r1, r2) + ELSIF opcode = IL.opGETC THEN + UnOp(r2); + r1 := GetAnyReg(); + movrc(r1, param1) + END; + drop; + drop; + + CASE param2 OF + |1: ldr8(r1, r1); str8(r2, r1) + |2: ldr16(r1, r1); str16(r2, r1) + |4: ldr32(r1, r1); str32(r2, r1) + END + + |IL.opNOT: + UnOp(r1); + Emit(opEQC, r1, 0) + + |IL.opORD: + UnOp(r1); + Emit(opNEC, r1, 0) + + |IL.opMIN: + BinOp(r1, r2); + Emit(opMIN, r1, r2); + drop + + |IL.opMAX: + BinOp(r1, r2); + Emit(opMAX, r1, r2); + drop + + |IL.opMINC: + UnOp(r1); + Emit(opMINC, r1, param2) + + |IL.opMAXC: + UnOp(r1); + Emit(opMAXC, r1, param2) + + |IL.opIN: + BinOp(r1, r2); + Emit(opIN, r1, r2); + drop + + |IL.opINL: + r1 := GetAnyReg(); + movrc(r1, param2); + BinOp(r2, r1); + Emit(opIN, r1, r2); + mov(r2, r1); + drop + + |IL.opINR: + UnOp(r1); + Emit(opINC, r1, param2) + + |IL.opERR: + CallRTL(IL._error, 4) + + |IL.opEQS .. IL.opGES: + PushAll(4); + pushc(opcode - IL.opEQS); + CallRTL(IL._strcmp, 5); + GetAcc + + |IL.opEQSW .. IL.opGESW: + PushAll(4); + pushc(opcode - IL.opEQSW); + CallRTL(IL._strcmpw, 5); + GetAcc + + |IL.opCOPY: + PushAll(2); + pushc(param2); + CallRTL(IL._move, 3) + + |IL.opMOVE: + PushAll(3); + CallRTL(IL._move, 3) + + |IL.opCOPYA: + PushAll(4); + pushc(param2); + CallRTL(IL._arrcpy, 5); + GetAcc + + |IL.opCOPYS: + PushAll(4); + pushc(param2); + CallRTL(IL._strcpy, 5) + + |IL.opROT: + PushAll(0); + mov(ACC, SP); + push(ACC); + pushc(param2); + CallRTL(IL._rot, 2) + + |IL.opLENGTH: + PushAll(2); + CallRTL(IL._length, 2); + GetAcc + + |IL.opLENGTHW: + PushAll(2); + CallRTL(IL._lengthw, 2); + GetAcc + + |IL.opSAVES: + UnOp(r2); + REG.PushAll_1(R); + r1 := GetAnyReg(); + StrAdr(r1, param2); + push(r1); + drop; + push(r2); + drop; + pushc(param1); + CallRTL(IL._move, 3) + + |IL.opRSET: + PushAll(2); + CallRTL(IL._set, 2); + GetAcc + + |IL.opRSETR: + PushAll(1); + pushc(param2); + CallRTL(IL._set, 2); + GetAcc + + |IL.opRSETL: + UnOp(r1); + REG.PushAll_1(R); + pushc(param2); + push(r1); + drop; + CallRTL(IL._set, 2); + GetAcc + + |IL.opRSET1: + PushAll(1); + CallRTL(IL._set1, 1); + GetAcc + + |IL.opNEW: + PushAll(1); + INC(param2, 8); + ASSERT(UTILS.Align(param2, 32)); + pushc(param2); + pushc(param1); + CallRTL(IL._new, 3) + + |IL.opTYPEGP: + UnOp(r1); + PushAll(0); + push(r1); + pushc(param2); + CallRTL(IL._guard, 2); + GetAcc + + |IL.opIS: + PushAll(1); + pushc(param2); + CallRTL(IL._is, 2); + GetAcc + + |IL.opISREC: + PushAll(2); + pushc(param2); + CallRTL(IL._guardrec, 3); + GetAcc + + |IL.opTYPEGR: + PushAll(1); + pushc(param2); + CallRTL(IL._guardrec, 2); + GetAcc + + |IL.opTYPEGD: + UnOp(r1); + PushAll(0); + subrc(r1, 4); + ldr32(r1, r1); + push(r1); + pushc(param2); + CallRTL(IL._guardrec, 2); + GetAcc + + |IL.opCASET: + push(R1); + push(R1); + pushc(param2); + CallRTL(IL._guardrec, 2); + pop(R1); + jnz(ACC, param1) + + |IL.opCONSTF: + movrc(GetAnyReg(), UTILS.d2s(cmd.float)) + + |IL.opMULF: + PushAll(2); + CallRTL(IL._fmul, 2); + GetAcc + + |IL.opDIVF: + PushAll(2); + CallRTL(IL._fdiv, 2); + GetAcc + + |IL.opDIVFI: + PushAll(2); + CallRTL(IL._fdivi, 2); + GetAcc + + |IL.opADDF: + PushAll(2); + CallRTL(IL._fadd, 2); + GetAcc + + |IL.opSUBFI: + PushAll(2); + CallRTL(IL._fsubi, 2); + GetAcc + + |IL.opSUBF: + PushAll(2); + CallRTL(IL._fsub, 2); + GetAcc + + |IL.opEQF..IL.opGEF: + PushAll(2); + pushc(opcode - IL.opEQF); + CallRTL(IL._fcmp, 3); + GetAcc + + |IL.opFLOOR: + PushAll(1); + CallRTL(IL._floor, 1); + GetAcc + + |IL.opFLT: + PushAll(1); + CallRTL(IL._flt, 1); + GetAcc + + |IL.opUMINF: + UnOp(r1); + Emit(opXORC, r1, ORD({31})) + + |IL.opFABS: + UnOp(r1); + Emit(opANDC, r1, ORD({0..30})) + + |IL.opINF: + movrc(GetAnyReg(), inf) + + |IL.opPUSHF: + UnOp(r1); + push(r1); + drop + + |IL.opPACK: + PushAll(2); + CallRTL(IL._pack, 2) + + |IL.opPACKC: + PushAll(1); + pushc(param2); + CallRTL(IL._pack, 2) + + |IL.opUNPK: + PushAll(2); + CallRTL(IL._unpk, 2) + + |IL.opCODE: + OutInt(param2) + + END; + + cmd := cmd.next(IL.COMMAND) + END; + + ASSERT(R.pushed = 0); + ASSERT(R.top = -1) +END translate; + + +PROCEDURE prolog; +BEGIN + Emit(opLEA, SP + LStack * 256, 0); + Emit(opLEA, ACC + LTypes * 256, 0); + push(ACC); + Emit(opLEA, ACC + LHeap * 256, 0); + push(ACC); + pushc(CHL.Length(IL.codes.types)); + CallRTL(IL._init, 3) +END prolog; + + +PROCEDURE epilog (ram: INTEGER); +VAR + tcount, dcount, i, offTypes, offStrings, szData, szGlobal, szHeapStack: INTEGER; + +BEGIN + Emit(opSTOP, 0, 0); + + offTypes := count; + + tcount := CHL.Length(IL.codes.types); + FOR i := 0 TO tcount - 1 DO + OutInt(CHL.GetInt(IL.codes.types, i)) + END; + + offStrings := count; + dcount := CHL.Length(IL.codes.data); + FOR i := 0 TO dcount - 1 DO + OutByte(CHL.GetByte(IL.codes.data, i)) + END; + + IF dcount MOD 4 # 0 THEN + i := 4 - dcount MOD 4; + WHILE i > 0 DO + OutByte(0); + DEC(i) + END + END; + + szData := count - offTypes; + szGlobal := (IL.codes.bss DIV 4 + 1) * 4; + szHeapStack := ram - szData - szGlobal; + + OutInt(offTypes); + OutInt(offStrings); + OutInt(szGlobal DIV 4); + OutInt(szHeapStack DIV 4); + FOR i := 1 TO 8 DO + OutInt(0) + END +END epilog; + + +PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS); +CONST + minRAM = 32*1024; + maxRAM = 256*1024; + +VAR + szData, szRAM: INTEGER; + +BEGIN + szData := (CHL.Length(IL.codes.types) + CHL.Length(IL.codes.data) DIV 4 + IL.codes.bss DIV 4 + 2) * 4; + szRAM := MIN(MAX(options.ram, minRAM), maxRAM) * 1024; + + IF szRAM - szData < 1024*1024 THEN + ERRORS.Error(208) + END; + + count := 0; + WR.Create(outname); + + REG.Init(R, push, pop, mov, xchg, NIL, NIL, GPRs, {}); + + prolog; + translate; + epilog(szRAM); + + WR.Close +END CodeGen; + + +END RVM32I. \ No newline at end of file diff --git a/source/STATEMENTS.ob07 b/source/STATEMENTS.ob07 index a41502f..3529384 100644 --- a/source/STATEMENTS.ob07 +++ b/source/STATEMENTS.ob07 @@ -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; diff --git a/source/STRINGS.ob07 b/source/STRINGS.ob07 index 8c3df3e..8dfcb66 100644 --- a/source/STRINGS.ob07 +++ b/source/STRINGS.ob07 @@ -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; diff --git a/source/TARGETS.ob07 b/source/TARGETS.ob07 index 9f69ca7..58d7e01 100644 --- a/source/TARGETS.ob07 +++ b/source/TARGETS.ob07 @@ -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. \ No newline at end of file diff --git a/source/UTILS.ob07 b/source/UTILS.ob07 index 7021d80..101846b 100644 --- a/source/UTILS.ob07 +++ b/source/UTILS.ob07 @@ -23,7 +23,7 @@ CONST max32* = 2147483647; vMajor* = 1; - vMinor* = 39; + vMinor* = 40; FILE_EXT* = ".ob07"; RTL_NAME* = "RTL"; diff --git a/tools/RVM32I.ob07 b/tools/RVM32I.ob07 new file mode 100644 index 0000000..1aa501c --- /dev/null +++ b/tools/RVM32I.ob07 @@ -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 -run [program parameters] + RVM32I.exe -dis +*) + +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. \ No newline at end of file