0,0 → 1,543 |
(* |
BSD 2-Clause License |
|
Copyright (c) 2018-2021, Anton Krotov |
All rights reserved. |
*) |
|
MODULE RTL; |
|
IMPORT SYSTEM, API; |
|
|
CONST |
|
minint = ROR(1, 1); |
|
WORD = API.BIT_DEPTH DIV 8; |
|
|
VAR |
|
name: INTEGER; |
types: INTEGER; |
|
|
PROCEDURE [stdcall] _move* (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 _move; |
|
|
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, dst, src); |
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, dst, src) |
END _strcpy; |
|
|
PROCEDURE [stdcall] _rot* (Len, Ptr: INTEGER); |
BEGIN |
SYSTEM.CODE( |
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- Len *) |
08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- Ptr *) |
049H, (* dec ecx *) |
053H, (* push ebx *) |
08BH, 018H, (* mov ebx, dword [eax] *) |
(* L: *) |
08BH, 050H, 004H, (* mov edx, dword [eax + 4] *) |
089H, 010H, (* mov dword [eax], edx *) |
083H, 0C0H, 004H, (* add eax, 4 *) |
049H, (* dec ecx *) |
075H, 0F5H, (* jnz L *) |
089H, 018H, (* mov dword [eax], ebx *) |
05BH, (* pop ebx *) |
05DH, (* pop ebp *) |
0C2H, 008H, 000H (* ret 8 *) |
) |
END _rot; |
|
|
PROCEDURE [stdcall] _set* (b, a: INTEGER); (* {a..b} -> eax *) |
BEGIN |
SYSTEM.CODE( |
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- b *) |
08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- a *) |
039H, 0C8H, (* cmp eax, ecx *) |
07FH, 033H, (* jg L1 *) |
083H, 0F8H, 01FH, (* cmp eax, 31 *) |
07FH, 02EH, (* jg L1 *) |
085H, 0C9H, (* test ecx, ecx *) |
07CH, 02AH, (* jl L1 *) |
083H, 0F9H, 01FH, (* cmp ecx, 31 *) |
07EH, 005H, (* jle L3 *) |
0B9H, 01FH, 000H, 000H, 000H, (* mov ecx, 31 *) |
(* L3: *) |
085H, 0C0H, (* test eax, eax *) |
07DH, 002H, (* jge L2 *) |
031H, 0C0H, (* xor eax, eax *) |
(* L2: *) |
089H, 0CAH, (* mov edx, ecx *) |
029H, 0C2H, (* sub edx, eax *) |
0B8H, 000H, 000H, 000H, 080H, (* mov eax, 0x80000000 *) |
087H, 0CAH, (* xchg edx, ecx *) |
0D3H, 0F8H, (* sar eax, cl *) |
087H, 0CAH, (* xchg edx, ecx *) |
083H, 0E9H, 01FH, (* sub ecx, 31 *) |
0F7H, 0D9H, (* neg ecx *) |
0D3H, 0E8H, (* shr eax, cl *) |
05DH, (* pop ebp *) |
0C2H, 008H, 000H, (* ret 8 *) |
(* L1: *) |
031H, 0C0H, (* xor eax, eax *) |
05DH, (* pop ebp *) |
0C2H, 008H, 000H (* ret 8 *) |
) |
END _set; |
|
|
PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *) |
BEGIN |
SYSTEM.CODE( |
031H, 0C0H, (* xor eax, eax *) |
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- a *) |
083H, 0F9H, 01FH, (* cmp ecx, 31 *) |
077H, 003H, (* ja L *) |
00FH, 0ABH, 0C8H (* bts eax, ecx *) |
(* L: *) |
) |
END _set1; |
|
|
PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *) |
BEGIN |
SYSTEM.CODE( |
053H, (* push ebx *) |
08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- x *) |
031H, 0D2H, (* xor edx, edx *) |
085H, 0C0H, (* test eax, eax *) |
074H, 018H, (* je L2 *) |
07FH, 002H, (* jg L1 *) |
0F7H, 0D2H, (* not edx *) |
(* L1: *) |
089H, 0C3H, (* mov ebx, eax *) |
08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- y *) |
0F7H, 0F9H, (* idiv ecx *) |
085H, 0D2H, (* test edx, edx *) |
074H, 009H, (* je L2 *) |
031H, 0CBH, (* xor ebx, ecx *) |
085H, 0DBH, (* test ebx, ebx *) |
07DH, 003H, (* jge L2 *) |
048H, (* dec eax *) |
001H, 0CAH, (* add edx, ecx *) |
(* L2: *) |
05BH (* pop ebx *) |
) |
END _divmod; |
|
|
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); |
BEGIN |
ptr := API._NEW(size); |
IF ptr # 0 THEN |
SYSTEM.PUT(ptr, t); |
INC(ptr, WORD) |
END |
END _new; |
|
|
PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER); |
BEGIN |
IF ptr # 0 THEN |
ptr := API._DISPOSE(ptr - WORD) |
END |
END _dispose; |
|
|
PROCEDURE [stdcall] _length* (len, str: 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] *) |
) |
END _length; |
|
|
PROCEDURE [stdcall] _lengthw* (len, str: 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 *) |
) |
END _lengthw; |
|
|
PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER; |
BEGIN |
SYSTEM.CODE( |
056H, (* push esi *) |
057H, (* push edi *) |
053H, (* push ebx *) |
08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *) |
08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *) |
08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *) |
031H, 0C9H, (* xor ecx, ecx *) |
031H, 0D2H, (* xor edx, edx *) |
0B8H, |
000H, 000H, 000H, 080H, (* mov eax, minint *) |
(* L1: *) |
085H, 0DBH, (* test ebx, ebx *) |
07EH, 017H, (* jle L3 *) |
08AH, 00EH, (* mov cl, byte[esi] *) |
08AH, 017H, (* mov dl, byte[edi] *) |
046H, (* inc esi *) |
047H, (* inc edi *) |
04BH, (* dec ebx *) |
039H, 0D1H, (* cmp ecx, edx *) |
074H, 006H, (* je L2 *) |
089H, 0C8H, (* mov eax, ecx *) |
029H, 0D0H, (* sub eax, edx *) |
0EBH, 006H, (* jmp L3 *) |
(* L2: *) |
085H, 0C9H, (* test ecx, ecx *) |
075H, 0E7H, (* jne L1 *) |
031H, 0C0H, (* xor eax, eax *) |
(* L3: *) |
05BH, (* pop ebx *) |
05FH, (* pop edi *) |
05EH, (* pop esi *) |
05DH, (* pop ebp *) |
0C2H, 00CH, 000H (* ret 12 *) |
) |
RETURN 0 |
END strncmp; |
|
|
PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER; |
BEGIN |
SYSTEM.CODE( |
056H, (* push esi *) |
057H, (* push edi *) |
053H, (* push ebx *) |
08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *) |
08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *) |
08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *) |
031H, 0C9H, (* xor ecx, ecx *) |
031H, 0D2H, (* xor edx, edx *) |
0B8H, |
000H, 000H, 000H, 080H, (* mov eax, minint *) |
(* L1: *) |
085H, 0DBH, (* test ebx, ebx *) |
07EH, 01BH, (* jle L3 *) |
066H, 08BH, 00EH, (* mov cx, word[esi] *) |
066H, 08BH, 017H, (* mov dx, word[edi] *) |
046H, (* inc esi *) |
046H, (* inc esi *) |
047H, (* inc edi *) |
047H, (* inc edi *) |
04BH, (* dec ebx *) |
039H, 0D1H, (* cmp ecx, edx *) |
074H, 006H, (* je L2 *) |
089H, 0C8H, (* mov eax, ecx *) |
029H, 0D0H, (* sub eax, edx *) |
0EBH, 006H, (* jmp L3 *) |
(* L2: *) |
085H, 0C9H, (* test ecx, ecx *) |
075H, 0E3H, (* jne L1 *) |
031H, 0C0H, (* xor eax, eax *) |
(* L3: *) |
05BH, (* pop ebx *) |
05FH, (* pop edi *) |
05EH, (* pop esi *) |
05DH, (* pop ebp *) |
0C2H, 00CH, 000H (* ret 12 *) |
) |
RETURN 0 |
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: 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 append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); |
VAR |
n1, n2: INTEGER; |
|
BEGIN |
n1 := LENGTH(s1); |
n2 := LENGTH(s2); |
|
ASSERT(n1 + n2 < LEN(s1)); |
|
SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2); |
s1[n1 + n2] := 0X |
END append; |
|
|
PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER); |
VAR |
s, temp: ARRAY 1024 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; |
|
append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp); |
append(s, API.eol + "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 - WORD, 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 - WORD, 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; |
RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) |
END _dllentry; |
|
|
PROCEDURE [stdcall] _sofinit*; |
BEGIN |
API.sofinit |
END _sofinit; |
|
|
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 * WORD, t1) |
END; |
|
SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) |
END |
END; |
|
name := modname |
END _init; |
|
|
END RTL. |