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
parent
729487fd7a
commit
f86f8feb93
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -1,6 +1,6 @@
|
|||||||
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
|
||||||
|
|||||||
@ -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 / Дополнительные модули)
|
|
||||||
@ -1,2 +0,0 @@
|
|||||||
Compiler.exe source\Compiler.ob07 kosexe -out source\Compiler.kex -stk 2
|
|
||||||
@pause
|
|
||||||
@ -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;
|
||||||
|
|||||||
@ -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.
|
|
||||||
@ -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.
|
|
||||||
@ -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.
|
|
||||||
@ -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.
|
|
||||||
@ -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.
|
|
||||||
@ -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.
|
|
||||||
@ -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.
|
|
||||||
@ -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.
|
|
||||||
@ -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.
|
|
||||||
@ -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.
|
|
||||||
@ -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.
|
|
||||||
@ -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.
|
|
||||||
@ -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.
|
|
||||||
@ -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.
|
|
||||||
@ -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.
|
||||||
@ -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);
|
||||||
|
|
||||||
IF target = TARGETS.Win32DLL THEN
|
|
||||||
push(ebp);
|
push(ebp);
|
||||||
mov(ebp, esp);
|
mov(ebp, esp);
|
||||||
|
SetLabel(NewLabel());
|
||||||
|
mainFltConstLabel := CodeList.last(LABEL);
|
||||||
|
FltConstLabel := mainFltConstLabel;
|
||||||
|
mainLocVarSize := 0;
|
||||||
|
LocVarSize := 0;
|
||||||
|
|
||||||
|
IF target = TARGETS.Win32DLL THEN
|
||||||
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);
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user