forked from KolibriOS/kolibrios
630 lines
15 KiB
Plaintext
630 lines
15 KiB
Plaintext
(*
|
|
BSD 2-Clause License
|
|
|
|
Copyright (c) 2018, 2019, Anton Krotov
|
|
All rights reserved.
|
|
*)
|
|
|
|
MODULE RTL;
|
|
|
|
IMPORT SYSTEM, API;
|
|
|
|
|
|
CONST
|
|
|
|
bit_depth* = 32;
|
|
maxint* = 7FFFFFFFH;
|
|
minint* = 80000000H;
|
|
|
|
DLL_PROCESS_ATTACH = 1;
|
|
DLL_THREAD_ATTACH = 2;
|
|
DLL_THREAD_DETACH = 3;
|
|
DLL_PROCESS_DETACH = 0;
|
|
|
|
SIZE_OF_DWORD = 4;
|
|
MAX_SET = 31;
|
|
|
|
|
|
TYPE
|
|
|
|
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
|
|
PROC = PROCEDURE;
|
|
|
|
|
|
VAR
|
|
|
|
name: INTEGER;
|
|
types: INTEGER;
|
|
|
|
dll: RECORD
|
|
process_detach,
|
|
thread_detach,
|
|
thread_attach: DLL_ENTRY
|
|
END;
|
|
|
|
fini: PROC;
|
|
|
|
|
|
PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER);
|
|
BEGIN
|
|
SYSTEM.CODE(
|
|
|
|
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
|
|
085H, 0C0H, (* test eax, eax *)
|
|
07EH, 019H, (* jle L *)
|
|
0FCH, (* cld *)
|
|
057H, (* push edi *)
|
|
056H, (* push esi *)
|
|
08BH, 075H, 00CH, (* mov esi, dword [ebp + 12] *)
|
|
08BH, 07DH, 010H, (* mov edi, dword [ebp + 16] *)
|
|
089H, 0C1H, (* mov ecx, eax *)
|
|
0C1H, 0E9H, 002H, (* shr ecx, 2 *)
|
|
0F3H, 0A5H, (* rep movsd *)
|
|
089H, 0C1H, (* mov ecx, eax *)
|
|
083H, 0E1H, 003H, (* and ecx, 3 *)
|
|
0F3H, 0A4H, (* rep movsb *)
|
|
05EH, (* pop esi *)
|
|
05FH (* pop edi *)
|
|
(* L: *)
|
|
)
|
|
END _move;
|
|
|
|
|
|
PROCEDURE [stdcall] _move2* (bytes, dest, source: INTEGER);
|
|
BEGIN
|
|
SYSTEM.CODE(
|
|
|
|
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
|
|
085H, 0C0H, (* test eax, eax *)
|
|
07EH, 019H, (* jle L *)
|
|
0FCH, (* cld *)
|
|
057H, (* push edi *)
|
|
056H, (* push esi *)
|
|
08BH, 075H, 010H, (* mov esi, dword [ebp + 16] *)
|
|
08BH, 07DH, 00CH, (* mov edi, dword [ebp + 12] *)
|
|
089H, 0C1H, (* mov ecx, eax *)
|
|
0C1H, 0E9H, 002H, (* shr ecx, 2 *)
|
|
0F3H, 0A5H, (* rep movsd *)
|
|
089H, 0C1H, (* mov ecx, eax *)
|
|
083H, 0E1H, 003H, (* and ecx, 3 *)
|
|
0F3H, 0A4H, (* rep movsb *)
|
|
05EH, (* pop esi *)
|
|
05FH (* pop edi *)
|
|
(* L: *)
|
|
)
|
|
END _move2;
|
|
|
|
|
|
PROCEDURE [stdcall] _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, src, dst);
|
|
res := TRUE
|
|
END
|
|
|
|
RETURN res
|
|
END _arrcpy;
|
|
|
|
|
|
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
|
|
BEGIN
|
|
_move(MIN(len_dst, len_src) * chr_size, src, dst)
|
|
END _strcpy;
|
|
|
|
|
|
PROCEDURE [stdcall] _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 [stdcall] _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(ROR(1, 1), b - a), MAX_SET - b)
|
|
ELSE
|
|
a := 0
|
|
END
|
|
|
|
RETURN a
|
|
END _set;
|
|
|
|
|
|
PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
|
|
RETURN _set(b, a)
|
|
END _set2;
|
|
|
|
|
|
PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER;
|
|
BEGIN
|
|
SYSTEM.CODE(
|
|
|
|
08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
|
|
08BH, 04DH, 00CH, (* mov ecx, dword [ebp + 12] *)
|
|
031H, 0D2H, (* xor edx, edx *)
|
|
085H, 0C0H, (* test eax, eax *)
|
|
07DH, 002H, (* jge L1 *)
|
|
0F7H, 0D2H, (* not edx *)
|
|
(* L1: *)
|
|
0F7H, 0F9H, (* idiv ecx *)
|
|
08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *)
|
|
089H, 011H, (* mov dword [ecx], edx *)
|
|
0C9H, (* leave *)
|
|
0C2H, 00CH, 000H (* ret 12 *)
|
|
)
|
|
|
|
RETURN 0
|
|
END divmod;
|
|
|
|
|
|
PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
|
|
VAR
|
|
div, mod: INTEGER;
|
|
|
|
BEGIN
|
|
div := divmod(x, y, mod);
|
|
IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN
|
|
DEC(div)
|
|
END
|
|
|
|
RETURN div
|
|
END _div2;
|
|
|
|
|
|
PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
|
|
VAR
|
|
div, mod: INTEGER;
|
|
|
|
BEGIN
|
|
div := divmod(x, y, mod);
|
|
IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN
|
|
INC(mod, y)
|
|
END
|
|
|
|
RETURN mod
|
|
END _mod2;
|
|
|
|
|
|
PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
|
|
RETURN _div2(a, b)
|
|
END _div;
|
|
|
|
|
|
PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER;
|
|
RETURN _mod2(a, b)
|
|
END _mod;
|
|
|
|
|
|
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
|
|
BEGIN
|
|
ptr := API._NEW(size);
|
|
IF ptr # 0 THEN
|
|
SYSTEM.PUT(ptr, t);
|
|
INC(ptr, SIZE_OF_DWORD)
|
|
END
|
|
END _new;
|
|
|
|
|
|
PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
|
|
BEGIN
|
|
IF ptr # 0 THEN
|
|
ptr := API._DISPOSE(ptr - SIZE_OF_DWORD)
|
|
END
|
|
END _dispose;
|
|
|
|
|
|
PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
|
|
BEGIN
|
|
SYSTEM.CODE(
|
|
|
|
08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *)
|
|
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *)
|
|
048H, (* dec eax *)
|
|
(* L1: *)
|
|
040H, (* inc eax *)
|
|
080H, 038H, 000H, (* cmp byte [eax], 0 *)
|
|
074H, 003H, (* jz L2 *)
|
|
0E2H, 0F8H, (* loop L1 *)
|
|
040H, (* inc eax *)
|
|
(* L2: *)
|
|
02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *)
|
|
0C9H, (* leave *)
|
|
0C2H, 008H, 000H (* ret 08h *)
|
|
)
|
|
|
|
RETURN 0
|
|
END _length;
|
|
|
|
|
|
PROCEDURE [stdcall] _lengthw* (len, str: INTEGER): INTEGER;
|
|
BEGIN
|
|
SYSTEM.CODE(
|
|
|
|
08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *)
|
|
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *)
|
|
048H, (* dec eax *)
|
|
048H, (* dec eax *)
|
|
(* L1: *)
|
|
040H, (* inc eax *)
|
|
040H, (* inc eax *)
|
|
066H, 083H, 038H, 000H, (* cmp word [eax], 0 *)
|
|
074H, 004H, (* jz L2 *)
|
|
0E2H, 0F6H, (* loop L1 *)
|
|
040H, (* inc eax *)
|
|
040H, (* inc eax *)
|
|
(* L2: *)
|
|
02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *)
|
|
0D1H, 0E8H, (* shr eax, 1 *)
|
|
0C9H, (* leave *)
|
|
0C2H, 008H, 000H (* ret 08h *)
|
|
)
|
|
|
|
RETURN 0
|
|
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 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 [stdcall] _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 [stdcall] _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 PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
|
|
VAR
|
|
c: CHAR;
|
|
i: INTEGER;
|
|
|
|
BEGIN
|
|
i := 0;
|
|
REPEAT
|
|
SYSTEM.GET(pchar, c);
|
|
s[i] := c;
|
|
INC(pchar);
|
|
INC(i)
|
|
UNTIL c = 0X
|
|
END PCharToStr;
|
|
|
|
|
|
PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
|
|
VAR
|
|
i, a, b: INTEGER;
|
|
c: CHAR;
|
|
|
|
BEGIN
|
|
|
|
i := 0;
|
|
REPEAT
|
|
str[i] := CHR(x MOD 10 + ORD("0"));
|
|
x := x DIV 10;
|
|
INC(i)
|
|
UNTIL x = 0;
|
|
|
|
a := 0;
|
|
b := i - 1;
|
|
WHILE a < b DO
|
|
c := str[a];
|
|
str[a] := str[b];
|
|
str[b] := c;
|
|
INC(a);
|
|
DEC(b)
|
|
END;
|
|
str[i] := 0X
|
|
END IntToStr;
|
|
|
|
|
|
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
|
|
VAR
|
|
n1, n2, i, j: INTEGER;
|
|
BEGIN
|
|
n1 := LENGTH(s1);
|
|
n2 := LENGTH(s2);
|
|
|
|
ASSERT(n1 + n2 < LEN(s1));
|
|
|
|
i := 0;
|
|
j := n1;
|
|
WHILE i < n2 DO
|
|
s1[j] := s2[i];
|
|
INC(i);
|
|
INC(j)
|
|
END;
|
|
|
|
s1[j] := 0X
|
|
|
|
END append;
|
|
|
|
|
|
PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
|
|
VAR
|
|
s, temp: ARRAY 1024 OF CHAR;
|
|
|
|
BEGIN
|
|
|
|
s := "";
|
|
CASE err OF
|
|
| 1: append(s, "assertion failure")
|
|
| 2: append(s, "NIL dereference")
|
|
| 3: append(s, "division by zero")
|
|
| 4: append(s, "NIL procedure call")
|
|
| 5: append(s, "type guard error")
|
|
| 6: append(s, "index out of range")
|
|
| 7: append(s, "invalid CASE")
|
|
| 8: append(s, "array assignment error")
|
|
| 9: append(s, "CHR out of range")
|
|
|10: append(s, "WCHR out of range")
|
|
|11: append(s, "BYTE out of range")
|
|
END;
|
|
|
|
append(s, API.eol);
|
|
|
|
append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
|
|
append(s, "line: "); IntToStr(line, temp); append(s, temp);
|
|
|
|
API.DebugMsg(SYSTEM.ADR(s[0]), name);
|
|
|
|
API.exit_thread(0)
|
|
END _error;
|
|
|
|
|
|
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
|
|
BEGIN
|
|
SYSTEM.GET(t0 + t1 + types, t0)
|
|
RETURN t0 MOD 2
|
|
END _isrec;
|
|
|
|
|
|
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
|
|
BEGIN
|
|
IF p # 0 THEN
|
|
SYSTEM.GET(p - SIZE_OF_DWORD, p);
|
|
SYSTEM.GET(t0 + p + types, p)
|
|
END
|
|
|
|
RETURN p MOD 2
|
|
END _is;
|
|
|
|
|
|
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
|
|
BEGIN
|
|
SYSTEM.GET(t0 + t1 + types, t0)
|
|
RETURN t0 MOD 2
|
|
END _guardrec;
|
|
|
|
|
|
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
|
|
BEGIN
|
|
SYSTEM.GET(p, p);
|
|
IF p # 0 THEN
|
|
SYSTEM.GET(p - SIZE_OF_DWORD, p);
|
|
SYSTEM.GET(t0 + p + types, p)
|
|
ELSE
|
|
p := 1
|
|
END
|
|
|
|
RETURN p MOD 2
|
|
END _guard;
|
|
|
|
|
|
PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
|
|
VAR
|
|
res: INTEGER;
|
|
|
|
BEGIN
|
|
CASE fdwReason OF
|
|
|DLL_PROCESS_ATTACH:
|
|
res := 1
|
|
|DLL_THREAD_ATTACH:
|
|
res := 0;
|
|
IF dll.thread_attach # NIL THEN
|
|
dll.thread_attach(hinstDLL, fdwReason, lpvReserved)
|
|
END
|
|
|DLL_THREAD_DETACH:
|
|
res := 0;
|
|
IF dll.thread_detach # NIL THEN
|
|
dll.thread_detach(hinstDLL, fdwReason, lpvReserved)
|
|
END
|
|
|DLL_PROCESS_DETACH:
|
|
res := 0;
|
|
IF dll.process_detach # NIL THEN
|
|
dll.process_detach(hinstDLL, fdwReason, lpvReserved)
|
|
END
|
|
ELSE
|
|
res := 0
|
|
END
|
|
|
|
RETURN res
|
|
END _dllentry;
|
|
|
|
|
|
PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY);
|
|
BEGIN
|
|
dll.process_detach := process_detach;
|
|
dll.thread_detach := thread_detach;
|
|
dll.thread_attach := thread_attach
|
|
END SetDll;
|
|
|
|
|
|
PROCEDURE [stdcall] _exit* (code: INTEGER);
|
|
BEGIN
|
|
API.exit(code)
|
|
END _exit;
|
|
|
|
|
|
PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
|
|
VAR
|
|
t0, t1, i, j: INTEGER;
|
|
|
|
BEGIN
|
|
SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
|
|
API.init(param, code);
|
|
|
|
types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
|
|
ASSERT(types # 0);
|
|
FOR i := 0 TO tcount - 1 DO
|
|
FOR j := 0 TO tcount - 1 DO
|
|
t0 := i; t1 := j;
|
|
|
|
WHILE (t1 # 0) & (t1 # t0) DO
|
|
SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
|
|
END;
|
|
|
|
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
|
|
END
|
|
END;
|
|
|
|
name := modname;
|
|
|
|
dll.process_detach := NIL;
|
|
dll.thread_detach := NIL;
|
|
dll.thread_attach := NIL;
|
|
|
|
fini := NIL
|
|
END _init;
|
|
|
|
|
|
PROCEDURE [stdcall] _sofinit*;
|
|
BEGIN
|
|
IF fini # NIL THEN
|
|
fini
|
|
END
|
|
END _sofinit;
|
|
|
|
|
|
PROCEDURE SetFini* (ProcFini: PROC);
|
|
BEGIN
|
|
fini := ProcFini
|
|
END SetFini;
|
|
|
|
|
|
END RTL. |