Rev 7983 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
7983 | leency | 1 | (* |
2 | BSD 2-Clause License |
||
3 | |||
4 | Copyright (c) 2018-2020, Anton Krotov |
||
5 | All rights reserved. |
||
6 | *) |
||
7 | |||
8 | MODULE RTL; |
||
9 | |||
10 | IMPORT SYSTEM, API; |
||
11 | |||
12 | |||
13 | CONST |
||
14 | |||
15 | bit_depth* = 64; |
||
16 | maxint* = 7FFFFFFFFFFFFFFFH; |
||
17 | minint* = 8000000000000000H; |
||
18 | |||
19 | WORD = bit_depth DIV 8; |
||
20 | MAX_SET = bit_depth - 1; |
||
21 | |||
22 | |||
23 | VAR |
||
24 | |||
25 | name: INTEGER; |
||
26 | types: INTEGER; |
||
27 | sets: ARRAY (MAX_SET + 1) * (MAX_SET + 1) OF INTEGER; |
||
28 | |||
29 | |||
30 | PROCEDURE [stdcall64] _move* (bytes, dest, source: INTEGER); |
||
31 | BEGIN |
||
32 | SYSTEM.CODE( |
||
33 | 048H, 08BH, 045H, 010H, (* mov rax, qword [rbp + 16] *) |
||
34 | 048H, 085H, 0C0H, (* test rax, rax *) |
||
35 | 07EH, 020H, (* jle L *) |
||
36 | 0FCH, (* cld *) |
||
37 | 057H, (* push rdi *) |
||
38 | 056H, (* push rsi *) |
||
39 | 048H, 08BH, 075H, 020H, (* mov rsi, qword [rbp + 32] *) |
||
40 | 048H, 08BH, 07DH, 018H, (* mov rdi, qword [rbp + 24] *) |
||
41 | 048H, 089H, 0C1H, (* mov rcx, rax *) |
||
42 | 048H, 0C1H, 0E9H, 003H, (* shr rcx, 3 *) |
||
43 | 0F3H, 048H, 0A5H, (* rep movsd *) |
||
44 | 048H, 089H, 0C1H, (* mov rcx, rax *) |
||
45 | 048H, 083H, 0E1H, 007H, (* and rcx, 7 *) |
||
46 | 0F3H, 0A4H, (* rep movsb *) |
||
47 | 05EH, (* pop rsi *) |
||
48 | 05FH (* pop rdi *) |
||
49 | (* L: *) |
||
50 | ) |
||
51 | END _move; |
||
52 | |||
53 | |||
54 | PROCEDURE [stdcall64] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN; |
||
55 | VAR |
||
56 | res: BOOLEAN; |
||
57 | |||
58 | BEGIN |
||
59 | IF len_src > len_dst THEN |
||
60 | res := FALSE |
||
61 | ELSE |
||
62 | _move(len_src * base_size, dst, src); |
||
63 | res := TRUE |
||
64 | END |
||
65 | |||
66 | RETURN res |
||
67 | END _arrcpy; |
||
68 | |||
69 | |||
70 | PROCEDURE [stdcall64] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); |
||
71 | BEGIN |
||
72 | _move(MIN(len_dst, len_src) * chr_size, dst, src) |
||
73 | END _strcpy; |
||
74 | |||
75 | |||
76 | PROCEDURE [stdcall64] _rot* (VAR A: ARRAY OF INTEGER); |
||
77 | VAR |
||
78 | i, n, k: INTEGER; |
||
79 | |||
80 | BEGIN |
||
81 | k := LEN(A) - 1; |
||
82 | n := A[0]; |
||
83 | i := 0; |
||
84 | WHILE i < k DO |
||
85 | A[i] := A[i + 1]; |
||
86 | INC(i) |
||
87 | END; |
||
88 | A[k] := n |
||
89 | END _rot; |
||
90 | |||
91 | |||
92 | PROCEDURE [stdcall64] _set* (b, a: INTEGER): INTEGER; |
||
93 | BEGIN |
||
94 | IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN |
||
95 | SYSTEM.GET((MIN(b, MAX_SET) * (MAX_SET + 1) + MAX(a, 0)) * WORD + SYSTEM.ADR(sets[0]), a) |
||
96 | ELSE |
||
97 | a := 0 |
||
98 | END |
||
99 | |||
100 | RETURN a |
||
101 | END _set; |
||
102 | |||
103 | |||
104 | PROCEDURE [stdcall64] _set1* (a: INTEGER); (* {a} -> rax *) |
||
105 | BEGIN |
||
106 | SYSTEM.CODE( |
||
107 | 048H, 031H, 0C0H, (* xor rax, rax *) |
||
108 | 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- a *) |
||
109 | 048H, 083H, 0F9H, 03FH, (* cmp rcx, 63 *) |
||
110 | 077H, 004H, (* ja L *) |
||
111 | 048H, 00FH, 0ABH, 0C8H (* bts rax, rcx *) |
||
112 | (* L: *) |
||
113 | ) |
||
114 | END _set1; |
||
115 | |||
116 | |||
117 | PROCEDURE [stdcall64] _divmod* (y, x: INTEGER); (* (x div y) -> rax; (x mod y) -> rdx *) |
||
118 | BEGIN |
||
119 | SYSTEM.CODE( |
||
120 | 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) (* rax <- x *) |
||
121 | 048H, 031H, 0D2H, (* xor rdx, rdx *) |
||
122 | 048H, 085H, 0C0H, (* test rax, rax *) |
||
123 | 074H, 022H, (* je L2 *) |
||
124 | 07FH, 003H, (* jg L1 *) |
||
125 | 048H, 0F7H, 0D2H, (* not rdx *) |
||
126 | (* L1: *) |
||
127 | 049H, 089H, 0C0H, (* mov r8, rax *) |
||
128 | 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- y *) |
||
129 | 048H, 0F7H, 0F9H, (* idiv rcx *) |
||
130 | 048H, 085H, 0D2H, (* test rdx, rdx *) |
||
131 | 074H, 00EH, (* je L2 *) |
||
132 | 049H, 031H, 0C8H, (* xor r8, rcx *) |
||
133 | 04DH, 085H, 0C0H, (* test r8, r8 *) |
||
134 | 07DH, 006H, (* jge L2 *) |
||
135 | 048H, 0FFH, 0C8H, (* dec rax *) |
||
136 | 048H, 001H, 0CAH (* add rdx, rcx *) |
||
137 | (* L2: *) |
||
138 | ) |
||
139 | END _divmod; |
||
140 | |||
141 | |||
142 | PROCEDURE [stdcall64] _new* (t, size: INTEGER; VAR ptr: INTEGER); |
||
143 | BEGIN |
||
144 | ptr := API._NEW(size); |
||
145 | IF ptr # 0 THEN |
||
146 | SYSTEM.PUT(ptr, t); |
||
147 | INC(ptr, WORD) |
||
148 | END |
||
149 | END _new; |
||
150 | |||
151 | |||
152 | PROCEDURE [stdcall64] _dispose* (VAR ptr: INTEGER); |
||
153 | BEGIN |
||
154 | IF ptr # 0 THEN |
||
155 | ptr := API._DISPOSE(ptr - WORD) |
||
156 | END |
||
157 | END _dispose; |
||
158 | |||
159 | |||
160 | PROCEDURE [stdcall64] _length* (len, str: INTEGER); |
||
161 | BEGIN |
||
162 | SYSTEM.CODE( |
||
163 | 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) |
||
164 | 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) |
||
165 | 048H, 0FFH, 0C8H, (* dec rax *) |
||
166 | (* L1: *) |
||
167 | 048H, 0FFH, 0C0H, (* inc rax *) |
||
168 | 080H, 038H, 000H, (* cmp byte [rax], 0 *) |
||
169 | 074H, 005H, (* jz L2 *) |
||
170 | 0E2H, 0F6H, (* loop L1 *) |
||
171 | 048H, 0FFH, 0C0H, (* inc rax *) |
||
172 | (* L2: *) |
||
173 | 048H, 02BH, 045H, 018H (* sub rax, qword [rbp + 24] *) |
||
174 | ) |
||
175 | END _length; |
||
176 | |||
177 | |||
178 | PROCEDURE [stdcall64] _lengthw* (len, str: INTEGER); |
||
179 | BEGIN |
||
180 | SYSTEM.CODE( |
||
181 | 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) |
||
182 | 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) |
||
183 | 048H, 083H, 0E8H, 002H, (* sub rax, 2 *) |
||
184 | (* L1: *) |
||
185 | 048H, 083H, 0C0H, 002H, (* add rax, 2 *) |
||
186 | 066H, 083H, 038H, 000H, (* cmp word [rax], 0 *) |
||
187 | 074H, 006H, (* jz L2 *) |
||
188 | 0E2H, 0F4H, (* loop L1 *) |
||
189 | 048H, 083H, 0C0H, 002H, (* add rax, 2 *) |
||
190 | (* L2: *) |
||
191 | 048H, 02BH, 045H, 018H, (* sub rax, qword [rbp + 24] *) |
||
192 | 048H, 0D1H, 0E8H (* shr rax, 1 *) |
||
193 | ) |
||
194 | END _lengthw; |
||
195 | |||
196 | |||
197 | PROCEDURE [stdcall64] strncmp (a, b, n: INTEGER): INTEGER; |
||
198 | BEGIN |
||
199 | SYSTEM.CODE( |
||
200 | 048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *) |
||
201 | 048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *) |
||
202 | 04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *) |
||
203 | 04DH, 031H, 0C9H, (* xor r9, r9 *) |
||
204 | 04DH, 031H, 0D2H, (* xor r10, r10 *) |
||
205 | 048H, 0B8H, 000H, 000H, |
||
206 | 000H, 000H, 000H, 000H, |
||
207 | 000H, 080H, (* movabs rax, minint *) |
||
208 | (* L1: *) |
||
209 | 04DH, 085H, 0C0H, (* test r8, r8 *) |
||
210 | 07EH, 024H, (* jle L3 *) |
||
211 | 044H, 08AH, 009H, (* mov r9b, byte[rcx] *) |
||
212 | 044H, 08AH, 012H, (* mov r10b, byte[rdx] *) |
||
213 | 048H, 0FFH, 0C1H, (* inc rcx *) |
||
214 | 048H, 0FFH, 0C2H, (* inc rdx *) |
||
215 | 049H, 0FFH, 0C8H, (* dec r8 *) |
||
216 | 04DH, 039H, 0D1H, (* cmp r9, r10 *) |
||
217 | 074H, 008H, (* je L2 *) |
||
218 | 04CH, 089H, 0C8H, (* mov rax, r9 *) |
||
219 | 04CH, 029H, 0D0H, (* sub rax, r10 *) |
||
220 | 0EBH, 008H, (* jmp L3 *) |
||
221 | (* L2: *) |
||
222 | 04DH, 085H, 0C9H, (* test r9, r9 *) |
||
223 | 075H, 0DAH, (* jne L1 *) |
||
224 | 048H, 031H, 0C0H, (* xor rax, rax *) |
||
225 | (* L3: *) |
||
226 | 05DH, (* pop rbp *) |
||
227 | 0C2H, 018H, 000H (* ret 24 *) |
||
228 | ) |
||
229 | RETURN 0 |
||
230 | END strncmp; |
||
231 | |||
232 | |||
233 | PROCEDURE [stdcall64] strncmpw (a, b, n: INTEGER): INTEGER; |
||
234 | BEGIN |
||
235 | SYSTEM.CODE( |
||
236 | 048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *) |
||
237 | 048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *) |
||
238 | 04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *) |
||
239 | 04DH, 031H, 0C9H, (* xor r9, r9 *) |
||
240 | 04DH, 031H, 0D2H, (* xor r10, r10 *) |
||
241 | 048H, 0B8H, 000H, 000H, |
||
242 | 000H, 000H, 000H, 000H, |
||
243 | 000H, 080H, (* movabs rax, minint *) |
||
244 | (* L1: *) |
||
245 | 04DH, 085H, 0C0H, (* test r8, r8 *) |
||
246 | 07EH, 028H, (* jle L3 *) |
||
247 | 066H, 044H, 08BH, 009H, (* mov r9w, word[rcx] *) |
||
248 | 066H, 044H, 08BH, 012H, (* mov r10w, word[rdx] *) |
||
249 | 048H, 083H, 0C1H, 002H, (* add rcx, 2 *) |
||
250 | 048H, 083H, 0C2H, 002H, (* add rdx, 2 *) |
||
251 | 049H, 0FFH, 0C8H, (* dec r8 *) |
||
252 | 04DH, 039H, 0D1H, (* cmp r9, r10 *) |
||
253 | 074H, 008H, (* je L2 *) |
||
254 | 04CH, 089H, 0C8H, (* mov rax, r9 *) |
||
255 | 04CH, 029H, 0D0H, (* sub rax, r10 *) |
||
256 | 0EBH, 008H, (* jmp L3 *) |
||
257 | (* L2: *) |
||
258 | 04DH, 085H, 0C9H, (* test r9, r9 *) |
||
259 | 075H, 0D6H, (* jne L1 *) |
||
260 | 048H, 031H, 0C0H, (* xor rax, rax *) |
||
261 | (* L3: *) |
||
262 | 05DH, (* pop rbp *) |
||
263 | 0C2H, 018H, 000H (* ret 24 *) |
||
264 | ) |
||
265 | RETURN 0 |
||
266 | END strncmpw; |
||
267 | |||
268 | |||
269 | PROCEDURE [stdcall64] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; |
||
270 | VAR |
||
271 | res: INTEGER; |
||
272 | bRes: BOOLEAN; |
||
273 | c: CHAR; |
||
274 | |||
275 | BEGIN |
||
276 | res := strncmp(str1, str2, MIN(len1, len2)); |
||
277 | IF res = minint THEN |
||
278 | IF len1 > len2 THEN |
||
279 | SYSTEM.GET(str1 + len2, c); |
||
280 | res := ORD(c) |
||
281 | ELSIF len1 < len2 THEN |
||
282 | SYSTEM.GET(str2 + len1, c); |
||
283 | res := -ORD(c) |
||
284 | ELSE |
||
285 | res := 0 |
||
286 | END |
||
287 | END; |
||
288 | |||
289 | CASE op OF |
||
290 | |0: bRes := res = 0 |
||
291 | |1: bRes := res # 0 |
||
292 | |2: bRes := res < 0 |
||
293 | |3: bRes := res <= 0 |
||
294 | |4: bRes := res > 0 |
||
295 | |5: bRes := res >= 0 |
||
296 | END |
||
297 | |||
298 | RETURN bRes |
||
299 | END _strcmp; |
||
300 | |||
301 | |||
302 | PROCEDURE [stdcall64] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; |
||
303 | VAR |
||
304 | res: INTEGER; |
||
305 | bRes: BOOLEAN; |
||
306 | c: WCHAR; |
||
307 | |||
308 | BEGIN |
||
309 | res := strncmpw(str1, str2, MIN(len1, len2)); |
||
310 | IF res = minint THEN |
||
311 | IF len1 > len2 THEN |
||
312 | SYSTEM.GET(str1 + len2 * 2, c); |
||
313 | res := ORD(c) |
||
314 | ELSIF len1 < len2 THEN |
||
315 | SYSTEM.GET(str2 + len1 * 2, c); |
||
316 | res := -ORD(c) |
||
317 | ELSE |
||
318 | res := 0 |
||
319 | END |
||
320 | END; |
||
321 | |||
322 | CASE op OF |
||
323 | |0: bRes := res = 0 |
||
324 | |1: bRes := res # 0 |
||
325 | |2: bRes := res < 0 |
||
326 | |3: bRes := res <= 0 |
||
327 | |4: bRes := res > 0 |
||
328 | |5: bRes := res >= 0 |
||
329 | END |
||
330 | |||
331 | RETURN bRes |
||
332 | END _strcmpw; |
||
333 | |||
334 | |||
335 | PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); |
||
336 | VAR |
||
337 | c: CHAR; |
||
338 | i: INTEGER; |
||
339 | |||
340 | BEGIN |
||
341 | i := 0; |
||
342 | REPEAT |
||
343 | SYSTEM.GET(pchar, c); |
||
344 | s[i] := c; |
||
345 | INC(pchar); |
||
346 | INC(i) |
||
347 | UNTIL c = 0X |
||
348 | END PCharToStr; |
||
349 | |||
350 | |||
351 | PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR); |
||
352 | VAR |
||
8097 | maxcodehac | 353 | i, a: INTEGER; |
7983 | leency | 354 | |
355 | BEGIN |
||
356 | i := 0; |
||
8097 | maxcodehac | 357 | a := x; |
7983 | leency | 358 | REPEAT |
8097 | maxcodehac | 359 | INC(i); |
360 | a := a DIV 10 |
||
361 | UNTIL a = 0; |
||
362 | |||
363 | str[i] := 0X; |
||
364 | |||
365 | REPEAT |
||
366 | DEC(i); |
||
7983 | leency | 367 | str[i] := CHR(x MOD 10 + ORD("0")); |
8097 | maxcodehac | 368 | x := x DIV 10 |
369 | UNTIL x = 0 |
||
7983 | leency | 370 | END IntToStr; |
371 | |||
372 | |||
373 | PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); |
||
374 | VAR |
||
8097 | maxcodehac | 375 | n1, n2: INTEGER; |
7983 | leency | 376 | |
377 | BEGIN |
||
378 | n1 := LENGTH(s1); |
||
379 | n2 := LENGTH(s2); |
||
380 | |||
381 | ASSERT(n1 + n2 < LEN(s1)); |
||
382 | |||
8097 | maxcodehac | 383 | SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2); |
384 | s1[n1 + n2] := 0X |
||
7983 | leency | 385 | END append; |
386 | |||
387 | |||
8097 | maxcodehac | 388 | PROCEDURE [stdcall64] _error* (modnum, _module, err, line: INTEGER); |
7983 | leency | 389 | VAR |
390 | s, temp: ARRAY 1024 OF CHAR; |
||
391 | |||
392 | BEGIN |
||
393 | CASE err OF |
||
394 | | 1: s := "assertion failure" |
||
395 | | 2: s := "NIL dereference" |
||
396 | | 3: s := "bad divisor" |
||
397 | | 4: s := "NIL procedure call" |
||
398 | | 5: s := "type guard error" |
||
399 | | 6: s := "index out of range" |
||
400 | | 7: s := "invalid CASE" |
||
401 | | 8: s := "array assignment error" |
||
402 | | 9: s := "CHR out of range" |
||
403 | |10: s := "WCHR out of range" |
||
404 | |11: s := "BYTE out of range" |
||
405 | END; |
||
406 | |||
8097 | maxcodehac | 407 | append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp); |
408 | append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp); |
||
7983 | leency | 409 | |
410 | API.DebugMsg(SYSTEM.ADR(s[0]), name); |
||
411 | |||
412 | API.exit_thread(0) |
||
413 | END _error; |
||
414 | |||
415 | |||
416 | PROCEDURE [stdcall64] _isrec* (t0, t1, r: INTEGER): INTEGER; |
||
417 | BEGIN |
||
418 | SYSTEM.GET(t0 + t1 + types, t0) |
||
419 | RETURN t0 MOD 2 |
||
420 | END _isrec; |
||
421 | |||
422 | |||
423 | PROCEDURE [stdcall64] _is* (t0, p: INTEGER): INTEGER; |
||
424 | BEGIN |
||
425 | IF p # 0 THEN |
||
426 | SYSTEM.GET(p - WORD, p); |
||
427 | SYSTEM.GET(t0 + p + types, p) |
||
428 | END |
||
429 | |||
430 | RETURN p MOD 2 |
||
431 | END _is; |
||
432 | |||
433 | |||
434 | PROCEDURE [stdcall64] _guardrec* (t0, t1: INTEGER): INTEGER; |
||
435 | BEGIN |
||
436 | SYSTEM.GET(t0 + t1 + types, t0) |
||
437 | RETURN t0 MOD 2 |
||
438 | END _guardrec; |
||
439 | |||
440 | |||
441 | PROCEDURE [stdcall64] _guard* (t0, p: INTEGER): INTEGER; |
||
442 | BEGIN |
||
443 | SYSTEM.GET(p, p); |
||
444 | IF p # 0 THEN |
||
445 | SYSTEM.GET(p - WORD, p); |
||
446 | SYSTEM.GET(t0 + p + types, p) |
||
447 | ELSE |
||
448 | p := 1 |
||
449 | END |
||
450 | |||
451 | RETURN p MOD 2 |
||
452 | END _guard; |
||
453 | |||
454 | |||
455 | PROCEDURE [stdcall64] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; |
||
456 | RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved) |
||
457 | END _dllentry; |
||
458 | |||
459 | |||
460 | PROCEDURE [stdcall64] _sofinit*; |
||
461 | BEGIN |
||
462 | API.sofinit |
||
463 | END _sofinit; |
||
464 | |||
465 | |||
466 | PROCEDURE [stdcall64] _exit* (code: INTEGER); |
||
467 | BEGIN |
||
468 | API.exit(code) |
||
469 | END _exit; |
||
470 | |||
471 | |||
472 | PROCEDURE [stdcall64] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER); |
||
473 | VAR |
||
474 | t0, t1, i, j: INTEGER; |
||
475 | |||
476 | BEGIN |
||
477 | API.init(param, code); |
||
478 | |||
479 | types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER)); |
||
480 | ASSERT(types # 0); |
||
481 | FOR i := 0 TO tcount - 1 DO |
||
482 | FOR j := 0 TO tcount - 1 DO |
||
483 | t0 := i; t1 := j; |
||
484 | |||
485 | WHILE (t1 # 0) & (t1 # t0) DO |
||
486 | SYSTEM.GET(_types + t1 * WORD, t1) |
||
487 | END; |
||
488 | |||
489 | SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1)) |
||
490 | END |
||
491 | END; |
||
492 | |||
493 | FOR i := 0 TO MAX_SET DO |
||
494 | FOR j := 0 TO i DO |
||
495 | sets[i * (MAX_SET + 1) + j] := LSR(ASR(minint, i - j), MAX_SET - i) |
||
496 | END |
||
497 | END; |
||
498 | |||
499 | name := modname |
||
500 | END _init; |
||
501 | |||
502 | |||
503 | END RTL.>=>>>=>>>->->->->->->->->->=>=>> |