diff --git a/programs/develop/oberon07/Compiler b/programs/develop/oberon07/Compiler deleted file mode 100644 index a865f8db08..0000000000 Binary files a/programs/develop/oberon07/Compiler and /dev/null differ diff --git a/programs/develop/oberon07/Compiler.exe b/programs/develop/oberon07/Compiler.exe deleted file mode 100644 index 917767902d..0000000000 Binary files a/programs/develop/oberon07/Compiler.exe and /dev/null differ diff --git a/programs/develop/oberon07/Compiler.kex b/programs/develop/oberon07/Compiler.kex index fb9f76c67b..186e32a542 100644 Binary files a/programs/develop/oberon07/Compiler.kex and b/programs/develop/oberon07/Compiler.kex differ diff --git a/programs/develop/oberon07/LICENSE b/programs/develop/oberon07/LICENSE index 7fd6e69d3a..947fea54c0 100644 --- a/programs/develop/oberon07/LICENSE +++ b/programs/develop/oberon07/LICENSE @@ -1,25 +1,25 @@ -BSD 2-Clause License - -Copyright (c) 2018-2021, Anton Krotov -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -* Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. - -* Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +BSD 2-Clause License + +Copyright (c) 2018-2022, Anton Krotov +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/programs/develop/oberon07/README.md b/programs/develop/oberon07/README.md deleted file mode 100644 index e2d394b376..0000000000 --- a/programs/develop/oberon07/README.md +++ /dev/null @@ -1,6 +0,0 @@ -Oberon-07 compiler for x64 (Windows, Linux), x86 (Windows, Linux, KolibriOS), MSP430x{1,2}xx, STM32 Cortex-M3 -============================================ -**Links:** - -https://github.com/prospero78/obGraph (Тест графических возможностей компилятора Оберона-07) -https://github.com/VadimAnIsaev/Oberon-07-additional-modules (Additional modules / Дополнительные модули) diff --git a/programs/develop/oberon07/SelfKolibriOS.cmd b/programs/develop/oberon07/SelfKolibriOS.cmd deleted file mode 100644 index 069ab78cdb..0000000000 --- a/programs/develop/oberon07/SelfKolibriOS.cmd +++ /dev/null @@ -1,2 +0,0 @@ -Compiler.exe source\Compiler.ob07 kosexe -out source\Compiler.kex -stk 2 -@pause \ No newline at end of file diff --git a/programs/develop/oberon07/lib/KolibriOS/HOST.ob07 b/programs/develop/oberon07/lib/KolibriOS/HOST.ob07 index d053379b39..fcc0463cac 100644 --- a/programs/develop/oberon07/lib/KolibriOS/HOST.ob07 +++ b/programs/develop/oberon07/lib/KolibriOS/HOST.ob07 @@ -1,7 +1,7 @@ (* BSD 2-Clause License - Copyright (c) 2018-2021, Anton Krotov + Copyright (c) 2018-2022, Anton Krotov All rights reserved. *) @@ -59,7 +59,7 @@ VAR Params: ARRAY MAX_PARAM, 2 OF INTEGER; argc*: INTEGER; - maxreal*: REAL; + maxreal*, inf*: REAL; PROCEDURE [stdcall, "Console.obj", "con_init"] con_init (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER); @@ -537,6 +537,7 @@ BEGIN END END; + inf := SYSTEM.INF(); maxreal := 1.9; PACK(maxreal, 1023); Console := TRUE; diff --git a/programs/develop/oberon07/lib/RVM32I/FPU.ob07 b/programs/develop/oberon07/lib/RVM32I/FPU.ob07 deleted file mode 100644 index da30e4ea7c..0000000000 --- a/programs/develop/oberon07/lib/RVM32I/FPU.ob07 +++ /dev/null @@ -1,465 +0,0 @@ -(* - 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/programs/develop/oberon07/lib/RVM32I/HOST.ob07 b/programs/develop/oberon07/lib/RVM32I/HOST.ob07 deleted file mode 100644 index 380b75c355..0000000000 --- a/programs/develop/oberon07/lib/RVM32I/HOST.ob07 +++ /dev/null @@ -1,176 +0,0 @@ -(* - 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/programs/develop/oberon07/lib/RVM32I/Out.ob07 b/programs/develop/oberon07/lib/RVM32I/Out.ob07 deleted file mode 100644 index aad7567e73..0000000000 --- a/programs/develop/oberon07/lib/RVM32I/Out.ob07 +++ /dev/null @@ -1,273 +0,0 @@ -(* - BSD 2-Clause License - - Copyright (c) 2016, 2018, 2020, Anton Krotov - All rights reserved. -*) - -MODULE Out; - -IMPORT HOST, SYSTEM; - - -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 Inf (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 Inf; - - -PROCEDURE Ln*; -BEGIN - Char(0DX); - Char(0AX) -END Ln; - - -PROCEDURE unpk10 (VAR x: REAL; VAR n: INTEGER); -VAR - a, b: REAL; - -BEGIN - ASSERT(x > 0.0); - n := 0; - WHILE x < 1.0 DO - x := x * 10.0; - DEC(n) - END; - - a := 10.0; - b := 1.0; - - WHILE a <= x DO - b := a; - a := a * 10.0; - INC(n) - END; - x := x / b -END unpk10; - - -PROCEDURE _Real (x: REAL; width: INTEGER); -VAR - n, k, p: INTEGER; - -BEGIN - p := MIN(MAX(width - 7, 1), 10); - - width := width - p - 7; - WHILE width > 0 DO - Char(20X); - DEC(width) - END; - - IF x < 0.0 THEN - Char("-"); - x := -x - ELSE - Char(20X) - END; - - unpk10(x, n); - - k := FLOOR(x); - Char(CHR(k + 30H)); - Char("."); - - WHILE p > 0 DO - x := (x - FLT(k)) * 10.0; - k := FLOOR(x); - Char(CHR(k + 30H)); - DEC(p) - END; - - Char("E"); - IF n >= 0 THEN - Char("+") - ELSE - Char("-") - END; - n := ABS(n); - Char(CHR(n DIV 10 + 30H)); - Char(CHR(n MOD 10 + 30H)) -END _Real; - - -PROCEDURE Real* (x: REAL; width: INTEGER); -BEGIN - IF (x # x) OR (ABS(x) = SYSTEM.INF()) THEN - Inf(x, width) - ELSIF x = 0.0 THEN - WHILE width > 17 DO - Char(20X); - DEC(width) - END; - DEC(width, 8); - String(" 0.0"); - WHILE width > 0 DO - Char("0"); - DEC(width) - END; - String("E+00") - ELSE - _Real(x, width) - END -END Real; - - -PROCEDURE _FixReal (x: REAL; width, p: INTEGER); -VAR - n, k: INTEGER; - minus: BOOLEAN; - -BEGIN - minus := x < 0.0; - IF minus THEN - x := -x - END; - - unpk10(x, n); - - DEC(width, 3 + MAX(p, 0) + MAX(n, 0)); - WHILE width > 0 DO - Char(20X); - DEC(width) - END; - - IF minus THEN - Char("-") - ELSE - Char(20X) - END; - - IF n < 0 THEN - INC(n); - Char("0"); - Char("."); - WHILE (n < 0) & (p > 0) DO - Char("0"); - INC(n); - DEC(p) - END - ELSE - WHILE n >= 0 DO - k := FLOOR(x); - Char(CHR(k + 30H)); - x := (x - FLT(k)) * 10.0; - DEC(n) - END; - Char(".") - END; - - WHILE p > 0 DO - k := FLOOR(x); - Char(CHR(k + 30H)); - x := (x - FLT(k)) * 10.0; - DEC(p) - END - -END _FixReal; - - -PROCEDURE FixReal* (x: REAL; width, p: INTEGER); -BEGIN - IF (x # x) OR (ABS(x) = SYSTEM.INF()) THEN - Inf(x, width) - ELSIF x = 0.0 THEN - DEC(width, 3 + MAX(p, 0)); - WHILE width > 0 DO - Char(20X); - DEC(width) - END; - String(" 0."); - WHILE p > 0 DO - Char("0"); - DEC(p) - END - ELSE - _FixReal(x, width, p) - END -END FixReal; - - -PROCEDURE Open*; -END Open; - - -END Out. \ No newline at end of file diff --git a/programs/develop/oberon07/lib/RVM32I/RTL.ob07 b/programs/develop/oberon07/lib/RVM32I/RTL.ob07 deleted file mode 100644 index 8e12fed583..0000000000 --- a/programs/develop/oberon07/lib/RVM32I/RTL.ob07 +++ /dev/null @@ -1,390 +0,0 @@ -(* - 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 _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 < Trap.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/programs/develop/oberon07/lib/RVM32I/Trap.ob07 b/programs/develop/oberon07/lib/RVM32I/Trap.ob07 deleted file mode 100644 index 55bff41f70..0000000000 --- a/programs/develop/oberon07/lib/RVM32I/Trap.ob07 +++ /dev/null @@ -1,128 +0,0 @@ -(* - BSD 2-Clause License - - Copyright (c) 2020, Anton Krotov - All rights reserved. -*) - -MODULE Trap; - -IMPORT SYSTEM; - - -PROCEDURE [code] sp* (): INTEGER - 22, 0, 4; (* MOV R0, SP *) - - -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/programs/develop/oberon07/lib/RVMxI/32/FPU.ob07 b/programs/develop/oberon07/lib/RVMxI/32/FPU.ob07 deleted file mode 100644 index 28069c4feb..0000000000 --- a/programs/develop/oberon07/lib/RVMxI/32/FPU.ob07 +++ /dev/null @@ -1,460 +0,0 @@ -(* - BSD 2-Clause License - - Copyright (c) 2020-2021, 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 - t, e, d: INTEGER; - -BEGIN - e := (a DIV 800000H) MOD 256; - t := (b DIV 800000H) MOD 256; - d := e - t; - - 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 - ELSIF d < 0 THEN - IF d > -24 THEN - a := LSR(a, -d) - ELSE - a := 0 - END; - e := t - END; - - INC(a, b); - - IF a >= 1000000H THEN - a := a DIV 2; - INC(e) - END; - - IF e >= 255 THEN - e := 255; - a := 800000H - END - - RETURN (a - 800000H) + e * 800000H -END add2; - - -PROCEDURE sub2 (b, a: INTEGER): INTEGER; -VAR - t, e, d, s: INTEGER; - -BEGIN - e := (a DIV 800000H) MOD 256; - t := (b DIV 800000H) MOD 256; - - a := a MOD 800000H + 800000H; - b := b MOD 800000H + 800000H; - - d := e - t; - - IF (d > 0) OR (d = 0) & (a >= b) THEN - s := 0 - ELSE - e := t; - d := -d; - t := a; - a := b; - b := t; - s := 80000000H - END; - - IF d > 0 THEN - IF d < 24 THEN - b := LSR(b, d) - ELSE - b := 0 - END - END; - - DEC(a, b); - - IF a = 0 THEN - e := 0; - a := 800000H; - s := 0 - ELSE - WHILE a < 800000H DO - a := a * 2; - DEC(e) - END - END; - - IF e <= 0 THEN - e := 0; - a := 800000H; - s := 0 - END - - RETURN (a - 800000H) + e * 800000H + s -END sub2; - - -PROCEDURE zero (VAR x: INTEGER); -BEGIN - IF LSR(LSL(x, 1), 24) = 0 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 LSL(a, 1) = 0FF000000H -END isInf; - - -PROCEDURE isNormal (a, b: INTEGER): BOOLEAN; - RETURN (LSR(LSL(a, 1), 24) # 255) & (LSR(LSL(a, 1), 24) # 0) & - (LSR(LSL(b, 1), 24) # 255) & (LSR(LSL(b, 1), 24) # 0) -END isNormal; - - -PROCEDURE add* (b, a: INTEGER): INTEGER; -VAR - r: INTEGER; - -BEGIN - zero(a); zero(b); - - IF isNormal(a, b) THEN - - IF a > 0 THEN - IF b > 0 THEN - r := add2(b, a) - ELSE - r := sub2(b, a) - END - ELSE - IF b > 0 THEN - r := sub2(a, b) - ELSE - r := add2(b, a) + 80000000H - END - 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, b) THEN - - IF a > 0 THEN - IF b > 0 THEN - r := sub2(b, a) - ELSE - r := add2(b, a) - END - ELSE - IF b > 0 THEN - r := add2(b, a) + 80000000H - ELSE - r := sub2(a, b) - END - 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, b) THEN - r := mul2(b, a) - ELSIF isNaN(a) OR isNaN(b) OR (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, b) THEN - r := div2(b, a) - ELSIF isNaN(a) OR isNaN(b) OR 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 - ELSE - IF (a < 0) & (b < 0) THEN - INC(op, 6) - END; - - CASE op OF - |0, 6: res := a = b - |1, 7: res := a # b - |2, 10: res := a < b - |3, 11: res := a <= b - |4, 8: res := a > b - |5, 9: res := a >= b - END - END - - RETURN res -END cmp; - - -PROCEDURE flt* (x: INTEGER): INTEGER; -VAR - n, y, s: INTEGER; - -BEGIN - IF x = 0 THEN - s := 0; - x := 800000H; - n := -126 - ELSIF x = 80000000H THEN - s := 80000000H; - x := 800000H; - n := 32 - ELSE - IF x < 0 THEN - s := 80000000H; - x := -x - ELSE - s := 0 - END; - n := 0; - y := x; - WHILE y > 0 DO - y := y DIV 2; - INC(n) - END; - IF n > 24 THEN - x := LSR(x, n - 24) - ELSE - x := LSL(x, 24 - n) - END - END - - RETURN (x - 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/programs/develop/oberon07/lib/RVMxI/32/HOST.ob07 b/programs/develop/oberon07/lib/RVMxI/32/HOST.ob07 deleted file mode 100644 index 6d35610929..0000000000 --- a/programs/develop/oberon07/lib/RVMxI/32/HOST.ob07 +++ /dev/null @@ -1,185 +0,0 @@ -(* - BSD 2-Clause License - - Copyright (c) 2020-2021, Anton Krotov - All rights reserved. -*) - -MODULE HOST; - -IMPORT SYSTEM, Trap; - - -CONST - - $IF (host_linux) - - slash* = "/"; - eol* = 0AX; - - $ELSE - - slash* = "\"; - eol* = 0DX + 0AX; - - $END - - 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/programs/develop/oberon07/lib/RVMxI/32/Out.ob07 b/programs/develop/oberon07/lib/RVMxI/32/Out.ob07 deleted file mode 100644 index aad7567e73..0000000000 --- a/programs/develop/oberon07/lib/RVMxI/32/Out.ob07 +++ /dev/null @@ -1,273 +0,0 @@ -(* - BSD 2-Clause License - - Copyright (c) 2016, 2018, 2020, Anton Krotov - All rights reserved. -*) - -MODULE Out; - -IMPORT HOST, SYSTEM; - - -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 Inf (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 Inf; - - -PROCEDURE Ln*; -BEGIN - Char(0DX); - Char(0AX) -END Ln; - - -PROCEDURE unpk10 (VAR x: REAL; VAR n: INTEGER); -VAR - a, b: REAL; - -BEGIN - ASSERT(x > 0.0); - n := 0; - WHILE x < 1.0 DO - x := x * 10.0; - DEC(n) - END; - - a := 10.0; - b := 1.0; - - WHILE a <= x DO - b := a; - a := a * 10.0; - INC(n) - END; - x := x / b -END unpk10; - - -PROCEDURE _Real (x: REAL; width: INTEGER); -VAR - n, k, p: INTEGER; - -BEGIN - p := MIN(MAX(width - 7, 1), 10); - - width := width - p - 7; - WHILE width > 0 DO - Char(20X); - DEC(width) - END; - - IF x < 0.0 THEN - Char("-"); - x := -x - ELSE - Char(20X) - END; - - unpk10(x, n); - - k := FLOOR(x); - Char(CHR(k + 30H)); - Char("."); - - WHILE p > 0 DO - x := (x - FLT(k)) * 10.0; - k := FLOOR(x); - Char(CHR(k + 30H)); - DEC(p) - END; - - Char("E"); - IF n >= 0 THEN - Char("+") - ELSE - Char("-") - END; - n := ABS(n); - Char(CHR(n DIV 10 + 30H)); - Char(CHR(n MOD 10 + 30H)) -END _Real; - - -PROCEDURE Real* (x: REAL; width: INTEGER); -BEGIN - IF (x # x) OR (ABS(x) = SYSTEM.INF()) THEN - Inf(x, width) - ELSIF x = 0.0 THEN - WHILE width > 17 DO - Char(20X); - DEC(width) - END; - DEC(width, 8); - String(" 0.0"); - WHILE width > 0 DO - Char("0"); - DEC(width) - END; - String("E+00") - ELSE - _Real(x, width) - END -END Real; - - -PROCEDURE _FixReal (x: REAL; width, p: INTEGER); -VAR - n, k: INTEGER; - minus: BOOLEAN; - -BEGIN - minus := x < 0.0; - IF minus THEN - x := -x - END; - - unpk10(x, n); - - DEC(width, 3 + MAX(p, 0) + MAX(n, 0)); - WHILE width > 0 DO - Char(20X); - DEC(width) - END; - - IF minus THEN - Char("-") - ELSE - Char(20X) - END; - - IF n < 0 THEN - INC(n); - Char("0"); - Char("."); - WHILE (n < 0) & (p > 0) DO - Char("0"); - INC(n); - DEC(p) - END - ELSE - WHILE n >= 0 DO - k := FLOOR(x); - Char(CHR(k + 30H)); - x := (x - FLT(k)) * 10.0; - DEC(n) - END; - Char(".") - END; - - WHILE p > 0 DO - k := FLOOR(x); - Char(CHR(k + 30H)); - x := (x - FLT(k)) * 10.0; - DEC(p) - END - -END _FixReal; - - -PROCEDURE FixReal* (x: REAL; width, p: INTEGER); -BEGIN - IF (x # x) OR (ABS(x) = SYSTEM.INF()) THEN - Inf(x, width) - ELSIF x = 0.0 THEN - DEC(width, 3 + MAX(p, 0)); - WHILE width > 0 DO - Char(20X); - DEC(width) - END; - String(" 0."); - WHILE p > 0 DO - Char("0"); - DEC(p) - END - ELSE - _FixReal(x, width, p) - END -END FixReal; - - -PROCEDURE Open*; -END Open; - - -END Out. \ No newline at end of file diff --git a/programs/develop/oberon07/lib/RVMxI/32/RTL.ob07 b/programs/develop/oberon07/lib/RVMxI/32/RTL.ob07 deleted file mode 100644 index d23ad3735e..0000000000 --- a/programs/develop/oberon07/lib/RVMxI/32/RTL.ob07 +++ /dev/null @@ -1,411 +0,0 @@ -(* - BSD 2-Clause License - - Copyright (c) 2019-2021, 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 _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 - IF (source MOD WORD = 0) & (dest MOD WORD = 0) THEN - WHILE bytes >= WORD DO - SYSTEM.GET(source, i); - SYSTEM.PUT(dest, i); - INC(source, WORD); - INC(dest, WORD); - DEC(bytes, WORD) - END - 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 := minint; - 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 - res := 0; - n := 0 - END - END - RETURN res -END strncmp; - - -PROCEDURE _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; -VAR - res: INTEGER; - bRes: BOOLEAN; - c: CHAR; - -BEGIN - res := strncmp(str1, str2, MIN(len1, len2)); - IF res = minint THEN - IF len1 > len2 THEN - SYSTEM.GET(str1 + len2, c); - res := ORD(c) - ELSIF len1 < len2 THEN - SYSTEM.GET(str2 + len1, c); - res := -ORD(c) - ELSE - res := 0 - END - 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 := minint; - 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 = 0X THEN - res := 0; - n := 0 - END - END - RETURN res -END strncmpw; - - -PROCEDURE _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; -VAR - res: INTEGER; - bRes: BOOLEAN; - c: WCHAR; - -BEGIN - res := strncmpw(str1, str2, MIN(len1, len2)); - IF res = minint THEN - IF len1 > len2 THEN - SYSTEM.GET(str1 + len2 * 2, c); - res := ORD(c) - ELSIF len1 < len2 THEN - SYSTEM.GET(str2 + len1 * 2, c); - res := -ORD(c) - ELSE - res := 0 - END - 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); -VAR - ptr: INTEGER; - -BEGIN - ptr := Heap; - IF ptr + size < Trap.sp() - 64 THEN - INC(Heap, size); - p := ptr + WORD; - SYSTEM.PUT(ptr, t); - INC(ptr, WORD); - DEC(size, WORD); - WHILE size > 0 DO - SYSTEM.PUT(ptr, 0); - INC(ptr, WORD); - DEC(size, WORD) - END - 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/programs/develop/oberon07/lib/RVMxI/32/Trap.ob07 b/programs/develop/oberon07/lib/RVMxI/32/Trap.ob07 deleted file mode 100644 index 3148602620..0000000000 --- a/programs/develop/oberon07/lib/RVMxI/32/Trap.ob07 +++ /dev/null @@ -1,133 +0,0 @@ -(* - BSD 2-Clause License - - Copyright (c) 2020-2021, Anton Krotov - All rights reserved. -*) - -MODULE Trap; - -IMPORT SYSTEM; - - -CONST - - SP = 4; - - -PROCEDURE [code] sp* (): INTEGER - 22, 0, SP; (* MOV R0, SP *) - - -PROCEDURE [code] syscall* (ptr: INTEGER) - 22, 0, SP, (* MOV R0, SP *) - 27, 0, 4, (* ADD R0, 4 *) - 9, 0, 0, (* LDW R0, R0 *) - 67, 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/programs/develop/oberon07/lib/RVMxI/64/HOST.ob07 b/programs/develop/oberon07/lib/RVMxI/64/HOST.ob07 deleted file mode 100644 index ac5ba4f798..0000000000 --- a/programs/develop/oberon07/lib/RVMxI/64/HOST.ob07 +++ /dev/null @@ -1,201 +0,0 @@ -(* - BSD 2-Clause License - - Copyright (c) 2020-2021, Anton Krotov - All rights reserved. -*) - -MODULE HOST; - -IMPORT SYSTEM, Trap; - - -CONST - - $IF (host_linux) - - slash* = "/"; - eol* = 0AX; - - $ELSE - - slash* = "\"; - eol* = 0DX + 0AX; - - $END - - bit_depth* = 64; - maxint* = ROR(-2, 1); - minint* = ROR(1, 1); - - -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 splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; -VAR - res: INTEGER; - -BEGIN - a := 0; - b := 0; - SYSTEM.GET32(SYSTEM.ADR(x), a); - SYSTEM.GET32(SYSTEM.ADR(x) + 4, b); - SYSTEM.GET(SYSTEM.ADR(x), res) - RETURN res -END splitf; - - -PROCEDURE d2s* (x: REAL): INTEGER; -VAR - h, l, s, e: INTEGER; - -BEGIN - e := splitf(x, l, h); - - s := ASR(h, 31) MOD 2; - e := (h DIV 100000H) MOD 2048; - IF e <= 896 THEN - h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H; - REPEAT - h := h DIV 2; - INC(e) - UNTIL e = 897; - e := 896; - l := (h MOD 8) * 20000000H; - h := h DIV 8 - ELSIF (1151 <= e) & (e < 2047) THEN - e := 1151; - h := 0; - l := 0 - ELSIF e = 2047 THEN - e := 1151; - IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN - h := 80000H; - l := 0 - END - END; - DEC(e, 896) - - RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 -END d2s; - - -BEGIN - maxreal := 1.9; - PACK(maxreal, 1023) -END HOST. \ No newline at end of file diff --git a/programs/develop/oberon07/lib/RVMxI/64/Out.ob07 b/programs/develop/oberon07/lib/RVMxI/64/Out.ob07 deleted file mode 100644 index 5fbf92cc2f..0000000000 --- a/programs/develop/oberon07/lib/RVMxI/64/Out.ob07 +++ /dev/null @@ -1,288 +0,0 @@ -(* - BSD 2-Clause License - - Copyright (c) 2016, 2018, 2020-2021 Anton Krotov - All rights reserved. -*) - -MODULE Out; - -IMPORT HOST, SYSTEM; - - -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 21 OF CHAR; - -BEGIN - IF x = ROR(1, 1) THEN - str := "-9223372036854775808"; - DEC(width, 20) - 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; -CONST - INF = LSR(ASR(ROR(1, 1), 10), 1); - NINF = ASR(ASR(ROR(1, 1), 10), 1); - -VAR - a: INTEGER; - -BEGIN - SYSTEM.GET(SYSTEM.ADR(x), a) - RETURN (a > INF) OR (a < 0) & (a > NINF) -END IsNan; - - -PROCEDURE Inf (x: REAL; width: INTEGER); -VAR - s: ARRAY 5 OF CHAR; - -BEGIN - DEC(width, 4); - IF IsNan(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 Inf; - - -PROCEDURE Ln*; -BEGIN - Char(0DX); - Char(0AX) -END Ln; - - -PROCEDURE unpk10 (VAR x: REAL; VAR n: INTEGER); -VAR - a, b: REAL; - -BEGIN - ASSERT(x > 0.0); - n := 0; - WHILE x < 1.0 DO - x := x * 10.0; - DEC(n) - END; - - a := 10.0; - b := 1.0; - - WHILE a <= x DO - b := a; - a := a * 10.0; - INC(n) - END; - x := x / b -END unpk10; - - -PROCEDURE _Real (x: REAL; width: INTEGER); -VAR - n, k, p: INTEGER; - -BEGIN - p := MIN(MAX(width - 8, 1), 15); - - width := width - p - 8; - WHILE width > 0 DO - Char(20X); - DEC(width) - END; - - IF x < 0.0 THEN - Char("-"); - x := -x - ELSE - Char(20X) - END; - - unpk10(x, n); - - k := FLOOR(x); - Char(CHR(k + 30H)); - Char("."); - - WHILE p > 0 DO - x := (x - FLT(k)) * 10.0; - k := FLOOR(x); - Char(CHR(k + 30H)); - DEC(p) - END; - - Char("E"); - IF n >= 0 THEN - Char("+") - ELSE - Char("-") - END; - n := ABS(n); - Char(CHR(n DIV 100 + 30H)); n := n MOD 100; - Char(CHR(n DIV 10 + 30H)); - Char(CHR(n MOD 10 + 30H)) -END _Real; - - -PROCEDURE Real* (x: REAL; width: INTEGER); -BEGIN - IF IsNan(x) OR (ABS(x) = SYSTEM.INF()) THEN - Inf(x, width) - ELSIF x = 0.0 THEN - WHILE width > 23 DO - Char(20X); - DEC(width) - END; - DEC(width, 9); - String(" 0.0"); - WHILE width > 0 DO - Char("0"); - DEC(width) - END; - String("E+000") - ELSE - _Real(x, width) - END -END Real; - - -PROCEDURE _FixReal (x: REAL; width, p: INTEGER); -VAR - n, k: INTEGER; - minus: BOOLEAN; - -BEGIN - minus := x < 0.0; - IF minus THEN - x := -x - END; - - unpk10(x, n); - - DEC(width, 3 + MAX(p, 0) + MAX(n, 0)); - WHILE width > 0 DO - Char(20X); - DEC(width) - END; - - IF minus THEN - Char("-") - ELSE - Char(20X) - END; - - IF n < 0 THEN - INC(n); - Char("0"); - Char("."); - WHILE (n < 0) & (p > 0) DO - Char("0"); - INC(n); - DEC(p) - END - ELSE - WHILE n >= 0 DO - k := FLOOR(x); - Char(CHR(k + 30H)); - x := (x - FLT(k)) * 10.0; - DEC(n) - END; - Char(".") - END; - - WHILE p > 0 DO - k := FLOOR(x); - Char(CHR(k + 30H)); - x := (x - FLT(k)) * 10.0; - DEC(p) - END - -END _FixReal; - - -PROCEDURE FixReal* (x: REAL; width, p: INTEGER); -BEGIN - IF IsNan(x) OR (ABS(x) = SYSTEM.INF()) THEN - Inf(x, width) - ELSIF x = 0.0 THEN - DEC(width, 3 + MAX(p, 0)); - WHILE width > 0 DO - Char(20X); - DEC(width) - END; - String(" 0."); - WHILE p > 0 DO - Char("0"); - DEC(p) - END - ELSE - _FixReal(x, width, p) - END -END FixReal; - - -PROCEDURE Open*; -END Open; - - -END Out. \ No newline at end of file diff --git a/programs/develop/oberon07/lib/RVMxI/64/RTL.ob07 b/programs/develop/oberon07/lib/RVMxI/64/RTL.ob07 deleted file mode 100644 index 2c32d51ba8..0000000000 --- a/programs/develop/oberon07/lib/RVMxI/64/RTL.ob07 +++ /dev/null @@ -1,432 +0,0 @@ -(* - BSD 2-Clause License - - Copyright (c) 2019-2021, Anton Krotov - All rights reserved. -*) - -MODULE RTL; - -IMPORT SYSTEM, Trap; - - -CONST - - bit_depth = 64; - maxint = ROR(-2, 1); - minint = ROR(1, 1); - - WORD = bit_depth DIV 8; - MAX_SET = bit_depth - 1; - - -VAR - - Heap, Types, TypesCount: INTEGER; - - -PROCEDURE _error* (modnum, _module, err, line: INTEGER); -BEGIN - Trap.trap(modnum, _module, err, line) -END _error; - - -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 _fmul* (b, a: INTEGER): INTEGER; - RETURN syscall2(100, b, a) -END _fmul; - - -PROCEDURE _fdiv* (b, a: INTEGER): INTEGER; - RETURN syscall2(101, b, a) -END _fdiv; - - -PROCEDURE _fdivi* (b, a: INTEGER): INTEGER; - RETURN syscall2(101, a, b) -END _fdivi; - - -PROCEDURE _fadd* (b, a: INTEGER): INTEGER; - RETURN syscall2(102, b, a) -END _fadd; - - -PROCEDURE _fsub* (b, a: INTEGER): INTEGER; - RETURN syscall2(103, b, a) -END _fsub; - - -PROCEDURE _fsubi* (b, a: INTEGER): INTEGER; - RETURN syscall2(103, a, b) -END _fsubi; - - -PROCEDURE _fcmp* (op, b, a: INTEGER): BOOLEAN; - RETURN syscall3(104, op, b, a) # 0 -END _fcmp; - - -PROCEDURE _floor* (x: INTEGER): INTEGER; - RETURN syscall1(105, x) -END _floor; - - -PROCEDURE _flt* (x: INTEGER): INTEGER; - RETURN syscall1(106, x) -END _flt; - - -PROCEDURE _pack* (n: INTEGER; VAR x: SET); -BEGIN - n := LSL((LSR(ORD(x), 52) MOD 2048 + n) MOD 2048, 52); - x := x - {52..62} + BITS(n) -END _pack; - - -PROCEDURE _unpk* (VAR n: INTEGER; VAR x: SET); -BEGIN - n := LSR(ORD(x), 52) MOD 2048 - 1023; - x := x - {62} + {52..61} -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, 6) = 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 - IF (source MOD WORD = 0) & (dest MOD WORD = 0) THEN - WHILE bytes >= WORD DO - SYSTEM.GET(source, i); - SYSTEM.PUT(dest, i); - INC(source, WORD); - INC(dest, WORD); - DEC(bytes, WORD) - END - 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 := minint; - 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 - res := 0; - n := 0 - END - END - RETURN res -END strncmp; - - -PROCEDURE _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; -VAR - res: INTEGER; - bRes: BOOLEAN; - c: CHAR; - -BEGIN - res := strncmp(str1, str2, MIN(len1, len2)); - IF res = minint THEN - IF len1 > len2 THEN - SYSTEM.GET(str1 + len2, c); - res := ORD(c) - ELSIF len1 < len2 THEN - SYSTEM.GET(str2 + len1, c); - res := -ORD(c) - ELSE - res := 0 - END - 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 := minint; - 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 = 0X THEN - res := 0; - n := 0 - END - END - RETURN res -END strncmpw; - - -PROCEDURE _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; -VAR - res: INTEGER; - bRes: BOOLEAN; - c: WCHAR; - -BEGIN - res := strncmpw(str1, str2, MIN(len1, len2)); - IF res = minint THEN - IF len1 > len2 THEN - SYSTEM.GET(str1 + len2 * 2, c); - res := ORD(c) - ELSIF len1 < len2 THEN - SYSTEM.GET(str2 + len1 * 2, c); - res := -ORD(c) - ELSE - res := 0 - END - 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); -VAR - ptr: INTEGER; - -BEGIN - ptr := Heap; - IF ptr + size < Trap.sp() - 128 THEN - INC(Heap, size); - p := ptr + WORD; - SYSTEM.PUT(ptr, t); - INC(ptr, WORD); - DEC(size, WORD); - WHILE size > 0 DO - SYSTEM.PUT(ptr, 0); - INC(ptr, WORD); - DEC(size, WORD) - END - 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/programs/develop/oberon07/lib/RVMxI/64/Trap.ob07 b/programs/develop/oberon07/lib/RVMxI/64/Trap.ob07 deleted file mode 100644 index a1c2fb0800..0000000000 --- a/programs/develop/oberon07/lib/RVMxI/64/Trap.ob07 +++ /dev/null @@ -1,133 +0,0 @@ -(* - BSD 2-Clause License - - Copyright (c) 2020-2021, Anton Krotov - All rights reserved. -*) - -MODULE Trap; - -IMPORT SYSTEM; - - -CONST - - SP = 4; - - -PROCEDURE [code] sp* (): INTEGER - 22, 0, SP; (* MOV R0, SP *) - - -PROCEDURE [code] syscall* (ptr: INTEGER) - 22, 0, SP, (* MOV R0, SP *) - 27, 0, 8, (* ADD R0, 8 *) - 16, 0, 0, (* LDD R0, R0 *) - 67, 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/programs/develop/oberon07/source/UTILS.ob07 b/programs/develop/oberon07/source/UTILS.ob07 index de0fd80a6b..20b75a396a 100644 --- a/programs/develop/oberon07/source/UTILS.ob07 +++ b/programs/develop/oberon07/source/UTILS.ob07 @@ -23,8 +23,8 @@ CONST max32* = 2147483647; vMajor* = 1; - vMinor* = 56; - Date* = "21-jun-2022"; + vMinor* = 57; + Date* = "31-aug-2022"; FILE_EXT* = ".ob07"; RTL_NAME* = "RTL"; @@ -36,7 +36,7 @@ VAR time*: INTEGER; - maxreal*: REAL; + maxreal*, inf*: REAL; target*: @@ -212,5 +212,6 @@ END hexdgt; BEGIN time := HOST.GetTickCount(); + inf := HOST.inf; maxreal := HOST.maxreal END UTILS. \ No newline at end of file diff --git a/programs/develop/oberon07/source/X86.ob07 b/programs/develop/oberon07/source/X86.ob07 index 7212465645..5a28ba5918 100644 --- a/programs/develop/oberon07/source/X86.ob07 +++ b/programs/develop/oberon07/source/X86.ob07 @@ -94,12 +94,14 @@ VAR CodeList: LISTS.LIST; - tcount: INTEGER; + tcount, LocVarSize, mainLocVarSize: INTEGER; FR: ARRAY 1000 OF INTEGER; fname: PATHS.PATH; + FltConstLabel, mainFltConstLabel: LABEL; + PROCEDURE OutByte* (n: BYTE); VAR @@ -399,6 +401,40 @@ BEGIN END Reloc; +PROCEDURE PushFlt (label: LABEL; value: REAL); +VAR + a, b, n: INTEGER; + + + PROCEDURE pushImm (label: LABEL; value: INTEGER); + VAR + c: CODE; + i: INTEGER; + + BEGIN + NEW(c); + IF isByte(value) THEN + c.code[0] := 6AH; + c.code[1] := value MOD 256; + c.length := 2 + ELSE + c.code[0] := 68H; + FOR i := 1 TO 4 DO + c.code[i] := UTILS.Byte(value, i - 1) + END; + c.length := 5 + END; + LISTS.insertL(CodeList, label, c) + END pushImm; + + +BEGIN + n := UTILS.splitf(value, a, b); + pushImm(label, b); + pushImm(label, a) +END PushFlt; + + PROCEDURE jcc* (cc, label: INTEGER); VAR j: JCC; @@ -726,13 +762,25 @@ BEGIN END pushm; +PROCEDURE LoadFltConst (value: REAL); +BEGIN + PushFlt(FltConstLabel, value); + INC(LocVarSize, 8); + IF FltConstLabel = mainFltConstLabel THEN + mainLocVarSize := LocVarSize + END; + OutByte2(0DDH, 045H + long(-LocVarSize)); (* fld qword[ebp - LocVarSize] *) + OutIntByte(-LocVarSize) +END LoadFltConst; + + PROCEDURE translate (pic: BOOLEAN; stroffs: INTEGER); VAR cmd, next: COMMAND; reg1, reg2, reg3, fr: INTEGER; - n, a, b, label, cc: INTEGER; + n, a, label, cc: INTEGER; opcode, param1, param2: INTEGER; @@ -862,7 +910,10 @@ BEGIN pushc(0); DEC(n) END - END + END; + SetLabel(NewLabel()); + FltConstLabel := CodeList.last(LABEL); + LocVarSize := param2 * 4 |IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF: IF opcode = IL.opLEAVER THEN @@ -881,7 +932,7 @@ BEGIN ASSERT(fr = -1); - IF param1 > 0 THEN + IF LocVarSize > 0 THEN mov(esp, ebp) END; @@ -891,7 +942,9 @@ BEGIN OutByte(0C2H); OutWord(param2 * 4 MOD 65536) (* ret param2*4 *) ELSE ret - END + END; + FltConstLabel := mainFltConstLabel; + LocVarSize := mainLocVarSize |IL.opPUSHC: pushc(param2) @@ -1941,11 +1994,7 @@ BEGIN OutByte2(0D9H, 0E8H); (* fld1 *) OutByte2(0D9H, 0E0H) (* fchs *) ELSE - n := UTILS.splitf(float, a, b); - pushc(b); - pushc(a); - OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *) - addrc(esp, 8) + LoadFltConst(float) END |IL.opSAVEF, IL.opSAVEFI: @@ -2085,10 +2134,8 @@ BEGIN IF fr > MAX_FR THEN ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR) END; - pushc(7FF00000H); - pushc(0); - OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *) - addrc(esp, 8) + LoadFltConst(UTILS.inf) + |IL.opLADR_UNPK: n := param2 * 4; @@ -2227,7 +2274,7 @@ BEGIN END translate; -PROCEDURE prolog (pic: BOOLEAN; target, stack, dllinit, dllret: INTEGER); +PROCEDURE prolog (pic: BOOLEAN; target, stack, dllret: INTEGER): INTEGER; VAR reg1, entry, L, dcount: INTEGER; @@ -2236,9 +2283,15 @@ BEGIN SetLabel(entry); dcount := CHL.Length(IL.codes.data); + push(ebp); + mov(ebp, esp); + SetLabel(NewLabel()); + mainFltConstLabel := CodeList.last(LABEL); + FltConstLabel := mainFltConstLabel; + mainLocVarSize := 0; + LocVarSize := 0; + IF target = TARGETS.Win32DLL THEN - push(ebp); - mov(ebp, esp); pushm(ebp, 16); pushm(ebp, 12); pushm(ebp, 8); @@ -2247,7 +2300,6 @@ BEGIN jcc(je, dllret); pushc(0) ELSIF target = TARGETS.KolibriOSDLL THEN - SetLabel(dllinit); OutByte(68H); (* push IMPORT *) Reloc(BIN.IMPTAB, 0) ELSIF target = TARGETS.KolibriOS THEN @@ -2256,7 +2308,9 @@ BEGIN push(reg1); (* push IMPORT *) drop ELSIF target = TARGETS.Linux32 THEN - push(esp) + mov(eax, ebp); + addrc(eax, 4); + push(eax) ELSE pushc(0) END; @@ -2297,6 +2351,8 @@ BEGIN mov(esp, eax); SetLabel(L) END + + RETURN entry END prolog; @@ -2341,8 +2397,10 @@ BEGIN OutByte3(0C2H, 0CH, 0) (* ret 12 *) ELSIF target = TARGETS.KolibriOSDLL THEN movrc(eax, 1); + OutByte(0C9H); (* leave *) ret ELSIF target = TARGETS.Linux32SO THEN + OutByte(0C9H); (* leave *) ret; SetLabel(sofinit); CallRTL(pic, IL._sofinit); @@ -2400,7 +2458,6 @@ BEGIN program := BIN.create(IL.codes.lcount); - dllinit := NewLabel(); dllret := NewLabel(); sofinit := NewLabel(); @@ -2414,7 +2471,7 @@ BEGIN REG.Init(R, push, pop, mov, xchg, {eax, ecx, edx}); - prolog(opt.pic, target, opt.stack, dllinit, dllret); + dllinit := prolog(opt.pic, target, opt.stack, dllret); translate(opt.pic, tcount * 4); epilog(opt.pic, outname, target, opt.stack, opt.version, dllinit, dllret, sofinit);