oberon07:

- 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

Binary file not shown.

View File

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

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

View File

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

View File

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

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

View File

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

View File

@ -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);