Egor00f/kolibrios
1
0
Fork 0
forked from KolibriOS/kolibrios
Code Pull Requests Activity

oberon07:

Browse Source 
- faster loading of real constants into registers
- deleting unnecessary files

git-svn-id: svn://kolibrios.org@9873 a494cfbc-eb01-0410-851d-a64ba20cac60
This commit is contained in:
Anton Krotov 2022-08-31 20:51:32 +00:00
parent 729487fd7a
commit f86f8feb93
23 changed files with 110 additions and 4007 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
programs/develop/oberon07/Compiler
View File

Binary file not shown.

BIN
programs/develop/oberon07/Compiler.exe
View File

Binary file not shown.

BIN
programs/develop/oberon07/Compiler.kex
View File

Binary file not shown.

50
programs/develop/oberon07/LICENSE
View File

@ -1,25 +1,25 @@
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018-2021, Anton Krotov Copyright (c) 2018-2022, Anton Krotov
All rights reserved. All rights reserved.
Redistribution and use in source and binary forms, with or without Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met: modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this * Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer. list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice, * Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution. and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 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 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. OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

6
programs/develop/oberon07/README.md
View File

@ -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 / Дополнительные модули)

2
programs/develop/oberon07/SelfKolibriOS.cmd
View File

@ -1,2 +0,0 @@
Compiler.exe source\Compiler.ob07 kosexe -out source\Compiler.kex -stk 2
@pause

5
programs/develop/oberon07/lib/KolibriOS/HOST.ob07
View File

@ -1,7 +1,7 @@
(* (*
BSD 2-Clause License BSD 2-Clause License
Copyright (c) 2018-2021, Anton Krotov Copyright (c) 2018-2022, Anton Krotov
All rights reserved. All rights reserved.
*) *)
@ -59,7 +59,7 @@ VAR
Params: ARRAY MAX_PARAM, 2 OF INTEGER; Params: ARRAY MAX_PARAM, 2 OF INTEGER;
argc*: 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); 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
END; END;
inf := SYSTEM.INF();
maxreal := 1.9; maxreal := 1.9;
PACK(maxreal, 1023); PACK(maxreal, 1023);
Console := TRUE; Console := TRUE;

465
programs/develop/oberon07/lib/RVM32I/FPU.ob07
View File

@ -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.

176
programs/develop/oberon07/lib/RVM32I/HOST.ob07
View File

@ -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.

273
programs/develop/oberon07/lib/RVM32I/Out.ob07
View File

@ -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.

390
programs/develop/oberon07/lib/RVM32I/RTL.ob07
View File

@ -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.

128
programs/develop/oberon07/lib/RVM32I/Trap.ob07
View File

@ -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.

460
programs/develop/oberon07/lib/RVMxI/32/FPU.ob07
View File

@ -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.

185
programs/develop/oberon07/lib/RVMxI/32/HOST.ob07
View File

@ -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.

273
programs/develop/oberon07/lib/RVMxI/32/Out.ob07
View File

@ -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.

411
programs/develop/oberon07/lib/RVMxI/32/RTL.ob07
View File

@ -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.

133
programs/develop/oberon07/lib/RVMxI/32/Trap.ob07
View File

@ -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.

201
programs/develop/oberon07/lib/RVMxI/64/HOST.ob07
View File

@ -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.

288
programs/develop/oberon07/lib/RVMxI/64/Out.ob07
View File

@ -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.

432
programs/develop/oberon07/lib/RVMxI/64/RTL.ob07
View File

@ -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.

133
programs/develop/oberon07/lib/RVMxI/64/Trap.ob07
View File

@ -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.

7
programs/develop/oberon07/source/UTILS.ob07
View File

@ -23,8 +23,8 @@ CONST
max32* = 2147483647; max32* = 2147483647;
vMajor* = 1; vMajor* = 1;
vMinor* = 56; vMinor* = 57;
Date* = "21-jun-2022"; Date* = "31-aug-2022";
FILE_EXT* = ".ob07"; FILE_EXT* = ".ob07";
RTL_NAME* = "RTL"; RTL_NAME* = "RTL";
@ -36,7 +36,7 @@ VAR
time*: INTEGER; time*: INTEGER;
maxreal*: REAL; maxreal*, inf*: REAL;
target*: target*:
@ -212,5 +212,6 @@ END hexdgt;
BEGIN BEGIN
time := HOST.GetTickCount(); time := HOST.GetTickCount();
inf := HOST.inf;
maxreal := HOST.maxreal maxreal := HOST.maxreal
END UTILS. END UTILS.

99
programs/develop/oberon07/source/X86.ob07
View File

@ -94,12 +94,14 @@ VAR
CodeList: LISTS.LIST; CodeList: LISTS.LIST;
tcount: INTEGER; tcount, LocVarSize, mainLocVarSize: INTEGER;
FR: ARRAY 1000 OF INTEGER; FR: ARRAY 1000 OF INTEGER;
fname: PATHS.PATH; fname: PATHS.PATH;
FltConstLabel, mainFltConstLabel: LABEL;
PROCEDURE OutByte* (n: BYTE); PROCEDURE OutByte* (n: BYTE);
VAR VAR
@ -399,6 +401,40 @@ BEGIN
END Reloc; 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); PROCEDURE jcc* (cc, label: INTEGER);
VAR VAR
j: JCC; j: JCC;
@ -726,13 +762,25 @@ BEGIN
END pushm; 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); PROCEDURE translate (pic: BOOLEAN; stroffs: INTEGER);
VAR VAR
cmd, next: COMMAND; cmd, next: COMMAND;
reg1, reg2, reg3, fr: INTEGER; reg1, reg2, reg3, fr: INTEGER;
n, a, b, label, cc: INTEGER; n, a, label, cc: INTEGER;
opcode, param1, param2: INTEGER; opcode, param1, param2: INTEGER;
@ -862,7 +910,10 @@ BEGIN
pushc(0); pushc(0);
DEC(n) DEC(n)
END END
END END;
SetLabel(NewLabel());
FltConstLabel := CodeList.last(LABEL);
LocVarSize := param2 * 4
|IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF: |IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF:
IF opcode = IL.opLEAVER THEN IF opcode = IL.opLEAVER THEN
@ -881,7 +932,7 @@ BEGIN
ASSERT(fr = -1); ASSERT(fr = -1);
IF param1 > 0 THEN IF LocVarSize > 0 THEN
mov(esp, ebp) mov(esp, ebp)
END; END;
@ -891,7 +942,9 @@ BEGIN
OutByte(0C2H); OutWord(param2 * 4 MOD 65536) (* ret param2*4 *) OutByte(0C2H); OutWord(param2 * 4 MOD 65536) (* ret param2*4 *)
ELSE ELSE
ret ret
END END;
FltConstLabel := mainFltConstLabel;
LocVarSize := mainLocVarSize
|IL.opPUSHC: |IL.opPUSHC:
pushc(param2) pushc(param2)
@ -1941,11 +1994,7 @@ BEGIN
OutByte2(0D9H, 0E8H); (* fld1 *) OutByte2(0D9H, 0E8H); (* fld1 *)
OutByte2(0D9H, 0E0H) (* fchs *) OutByte2(0D9H, 0E0H) (* fchs *)
ELSE ELSE
n := UTILS.splitf(float, a, b); LoadFltConst(float)
pushc(b);
pushc(a);
OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *)
addrc(esp, 8)
END END
|IL.opSAVEF, IL.opSAVEFI: |IL.opSAVEF, IL.opSAVEFI:
@ -2085,10 +2134,8 @@ BEGIN
IF fr > MAX_FR THEN IF fr > MAX_FR THEN
ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR) ERRORS.ErrorMsg(fname, param1, param2, FPR_ERR)
END; END;
pushc(7FF00000H); LoadFltConst(UTILS.inf)
pushc(0);
OutByte3(0DDH, 004H, 024H); (* fld qword[esp] *)
addrc(esp, 8)
|IL.opLADR_UNPK: |IL.opLADR_UNPK:
n := param2 * 4; n := param2 * 4;
@ -2227,7 +2274,7 @@ BEGIN
END translate; END translate;
PROCEDURE prolog (pic: BOOLEAN; target, stack, dllinit, dllret: INTEGER); PROCEDURE prolog (pic: BOOLEAN; target, stack, dllret: INTEGER): INTEGER;
VAR VAR
reg1, entry, L, dcount: INTEGER; reg1, entry, L, dcount: INTEGER;
@ -2236,9 +2283,15 @@ BEGIN
SetLabel(entry); SetLabel(entry);
dcount := CHL.Length(IL.codes.data); 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 IF target = TARGETS.Win32DLL THEN
push(ebp);
mov(ebp, esp);
pushm(ebp, 16); pushm(ebp, 16);
pushm(ebp, 12); pushm(ebp, 12);
pushm(ebp, 8); pushm(ebp, 8);
@ -2247,7 +2300,6 @@ BEGIN
jcc(je, dllret); jcc(je, dllret);
pushc(0) pushc(0)
ELSIF target = TARGETS.KolibriOSDLL THEN ELSIF target = TARGETS.KolibriOSDLL THEN
SetLabel(dllinit);
OutByte(68H); (* push IMPORT *) OutByte(68H); (* push IMPORT *)
Reloc(BIN.IMPTAB, 0) Reloc(BIN.IMPTAB, 0)
ELSIF target = TARGETS.KolibriOS THEN ELSIF target = TARGETS.KolibriOS THEN
@ -2256,7 +2308,9 @@ BEGIN
push(reg1); (* push IMPORT *) push(reg1); (* push IMPORT *)
drop drop
ELSIF target = TARGETS.Linux32 THEN ELSIF target = TARGETS.Linux32 THEN
push(esp) mov(eax, ebp);
addrc(eax, 4);
push(eax)
ELSE ELSE
pushc(0) pushc(0)
END; END;
@ -2297,6 +2351,8 @@ BEGIN
mov(esp, eax); mov(esp, eax);
SetLabel(L) SetLabel(L)
END END
RETURN entry
END prolog; END prolog;
@ -2341,8 +2397,10 @@ BEGIN
OutByte3(0C2H, 0CH, 0) (* ret 12 *) OutByte3(0C2H, 0CH, 0) (* ret 12 *)
ELSIF target = TARGETS.KolibriOSDLL THEN ELSIF target = TARGETS.KolibriOSDLL THEN
movrc(eax, 1); movrc(eax, 1);
OutByte(0C9H); (* leave *)
ret ret
ELSIF target = TARGETS.Linux32SO THEN ELSIF target = TARGETS.Linux32SO THEN
OutByte(0C9H); (* leave *)
ret; ret;
SetLabel(sofinit); SetLabel(sofinit);
CallRTL(pic, IL._sofinit); CallRTL(pic, IL._sofinit);
@ -2400,7 +2458,6 @@ BEGIN
program := BIN.create(IL.codes.lcount); program := BIN.create(IL.codes.lcount);
dllinit := NewLabel();
dllret := NewLabel(); dllret := NewLabel();
sofinit := NewLabel(); sofinit := NewLabel();
@ -2414,7 +2471,7 @@ BEGIN
REG.Init(R, push, pop, mov, xchg, {eax, ecx, edx}); 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); translate(opt.pic, tcount * 4);
epilog(opt.pic, outname, target, opt.stack, opt.version, dllinit, dllret, sofinit); epilog(opt.pic, outname, target, opt.stack, opt.version, dllinit, dllret, sofinit);