Rev 7107 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
7597 | akron1 | 1 | (* |
2 | BSD 2-Clause License |
||
6613 | leency | 3 | |
7597 | akron1 | 4 | Copyright (c) 2018, 2019, Anton Krotov |
5 | All rights reserved. |
||
6613 | leency | 6 | *) |
7 | |||
8 | MODULE RTL; |
||
9 | |||
7597 | akron1 | 10 | IMPORT SYSTEM, API; |
6613 | leency | 11 | |
7597 | akron1 | 12 | |
13 | CONST |
||
14 | |||
15 | bit_depth* = 32; |
||
16 | maxint* = 7FFFFFFFH; |
||
17 | minint* = 80000000H; |
||
18 | |||
19 | DLL_PROCESS_ATTACH = 1; |
||
20 | DLL_THREAD_ATTACH = 2; |
||
21 | DLL_THREAD_DETACH = 3; |
||
22 | DLL_PROCESS_DETACH = 0; |
||
23 | |||
24 | SIZE_OF_DWORD = 4; |
||
25 | |||
26 | |||
6613 | leency | 27 | TYPE |
28 | |||
7597 | akron1 | 29 | DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); |
6613 | leency | 30 | |
7597 | akron1 | 31 | |
6613 | leency | 32 | VAR |
33 | |||
7597 | akron1 | 34 | name: INTEGER; |
35 | types: INTEGER; |
||
6613 | leency | 36 | |
7597 | akron1 | 37 | dll: RECORD |
38 | process_detach, |
||
39 | thread_detach, |
||
40 | thread_attach: DLL_ENTRY |
||
41 | END; |
||
42 | |||
43 | |||
44 | PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); |
||
6613 | leency | 45 | BEGIN |
7597 | akron1 | 46 | SYSTEM.CODE( |
6613 | leency | 47 | |
7597 | akron1 | 48 | 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) |
49 | 085H, 0C0H, (* test eax, eax *) |
||
50 | 07EH, 019H, (* jle L *) |
||
51 | 0FCH, (* cld *) |
||
52 | 057H, (* push edi *) |
||
53 | 056H, (* push esi *) |
||
54 | 08BH, 075H, 00CH, (* mov esi, dword [ebp + 12] *) |
||
55 | 08BH, 07DH, 010H, (* mov edi, dword [ebp + 16] *) |
||
56 | 089H, 0C1H, (* mov ecx, eax *) |
||
57 | 0C1H, 0E9H, 002H, (* shr ecx, 2 *) |
||
58 | 0F3H, 0A5H, (* rep movsd *) |
||
59 | 089H, 0C1H, (* mov ecx, eax *) |
||
60 | 083H, 0E1H, 003H, (* and ecx, 3 *) |
||
61 | 0F3H, 0A4H, (* rep movsb *) |
||
62 | 05EH, (* pop esi *) |
||
63 | 05FH (* pop edi *) |
||
64 | (* L: *) |
||
65 | ) |
||
66 | END _move; |
||
67 | |||
68 | |||
69 | PROCEDURE [stdcall] _move2* (bytes, dest, source: INTEGER); |
||
6613 | leency | 70 | BEGIN |
7597 | akron1 | 71 | SYSTEM.CODE( |
6613 | leency | 72 | |
7597 | akron1 | 73 | 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) |
74 | 085H, 0C0H, (* test eax, eax *) |
||
75 | 07EH, 019H, (* jle L *) |
||
76 | 0FCH, (* cld *) |
||
77 | 057H, (* push edi *) |
||
78 | 056H, (* push esi *) |
||
79 | 08BH, 075H, 010H, (* mov esi, dword [ebp + 16] *) |
||
80 | 08BH, 07DH, 00CH, (* mov edi, dword [ebp + 12] *) |
||
81 | 089H, 0C1H, (* mov ecx, eax *) |
||
82 | 0C1H, 0E9H, 002H, (* shr ecx, 2 *) |
||
83 | 0F3H, 0A5H, (* rep movsd *) |
||
84 | 089H, 0C1H, (* mov ecx, eax *) |
||
85 | 083H, 0E1H, 003H, (* and ecx, 3 *) |
||
86 | 0F3H, 0A4H, (* rep movsb *) |
||
87 | 05EH, (* pop esi *) |
||
88 | 05FH (* pop edi *) |
||
89 | (* L: *) |
||
90 | ) |
||
91 | END _move2; |
||
92 | |||
93 | |||
94 | PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN; |
||
95 | VAR |
||
96 | res: BOOLEAN; |
||
97 | |||
6613 | leency | 98 | BEGIN |
7597 | akron1 | 99 | IF len_src > len_dst THEN |
100 | res := FALSE |
||
101 | ELSE |
||
102 | _move(len_src * base_size, src, dst); |
||
103 | res := TRUE |
||
104 | END |
||
6613 | leency | 105 | |
7597 | akron1 | 106 | RETURN res |
107 | END _arrcpy; |
||
108 | |||
109 | |||
110 | PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER); |
||
6613 | leency | 111 | BEGIN |
7597 | akron1 | 112 | _move(MIN(len_dst, len_src) * chr_size, src, dst) |
113 | END _strcpy; |
||
6613 | leency | 114 | |
7597 | akron1 | 115 | |
116 | PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER); |
||
6613 | leency | 117 | BEGIN |
7597 | akron1 | 118 | _move(MIN(len_dst, len_src) * chr_size, src, dst) |
119 | END _strcpy2; |
||
6613 | leency | 120 | |
7597 | akron1 | 121 | |
122 | PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER); |
||
123 | VAR |
||
124 | i, n, k: INTEGER; |
||
125 | |||
6613 | leency | 126 | BEGIN |
127 | |||
7597 | akron1 | 128 | k := LEN(A) - 1; |
129 | n := A[0]; |
||
130 | i := 0; |
||
131 | WHILE i < k DO |
||
132 | A[i] := A[i + 1]; |
||
133 | INC(i) |
||
134 | END; |
||
135 | A[k] := n |
||
136 | |||
137 | END _rot; |
||
138 | |||
139 | |||
140 | PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; |
||
141 | VAR |
||
142 | res: INTEGER; |
||
143 | |||
6613 | leency | 144 | BEGIN |
7597 | akron1 | 145 | IF (a <= b) & (a <= 31) & (b >= 0) THEN |
146 | IF b > 31 THEN |
||
147 | b := 31 |
||
148 | END; |
||
149 | IF a < 0 THEN |
||
150 | a := 0 |
||
151 | END; |
||
152 | res := LSR(ASR(ROR(1, 1), b - a), 31 - b) |
||
153 | ELSE |
||
154 | res := 0 |
||
155 | END |
||
6613 | leency | 156 | |
7597 | akron1 | 157 | RETURN res |
158 | END _set2; |
||
159 | |||
160 | |||
161 | PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; |
||
162 | RETURN _set2(a, b) |
||
163 | END _set; |
||
164 | |||
165 | |||
166 | PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; |
||
6613 | leency | 167 | BEGIN |
7597 | akron1 | 168 | SYSTEM.CODE( |
6613 | leency | 169 | |
7597 | akron1 | 170 | 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) |
171 | 08BH, 04DH, 00CH, (* mov ecx, dword [ebp + 12] *) |
||
172 | 031H, 0D2H, (* xor edx, edx *) |
||
173 | 085H, 0C0H, (* test eax, eax *) |
||
174 | 07DH, 002H, (* jge L1 *) |
||
175 | 0F7H, 0D2H, (* not edx *) |
||
176 | (* L1: *) |
||
177 | 0F7H, 0F9H, (* idiv ecx *) |
||
178 | 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) |
||
179 | 089H, 011H, (* mov dword [ecx], edx *) |
||
180 | 0C9H, (* leave *) |
||
181 | 0C2H, 00CH, 000H (* ret 12 *) |
||
182 | ) |
||
183 | |||
184 | RETURN 0 |
||
185 | END divmod; |
||
186 | |||
187 | |||
188 | PROCEDURE div_ (x, y: INTEGER): INTEGER; |
||
189 | VAR |
||
190 | div, mod: INTEGER; |
||
191 | |||
6613 | leency | 192 | BEGIN |
7597 | akron1 | 193 | div := divmod(x, y, mod); |
194 | IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN |
||
195 | DEC(div) |
||
196 | END |
||
6613 | leency | 197 | |
7597 | akron1 | 198 | RETURN div |
199 | END div_; |
||
200 | |||
201 | |||
202 | PROCEDURE mod_ (x, y: INTEGER): INTEGER; |
||
203 | VAR |
||
204 | div, mod: INTEGER; |
||
205 | |||
6613 | leency | 206 | BEGIN |
7597 | akron1 | 207 | div := divmod(x, y, mod); |
208 | IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN |
||
209 | INC(mod, y) |
||
210 | END |
||
6613 | leency | 211 | |
7597 | akron1 | 212 | RETURN mod |
213 | END mod_; |
||
214 | |||
215 | |||
216 | PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; |
||
217 | RETURN div_(a, b) |
||
218 | END _div; |
||
219 | |||
220 | |||
221 | PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER; |
||
222 | RETURN div_(a, b) |
||
223 | END _div2; |
||
224 | |||
225 | |||
226 | PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; |
||
227 | RETURN mod_(a, b) |
||
228 | END _mod; |
||
229 | |||
230 | |||
231 | PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER; |
||
232 | RETURN mod_(a, b) |
||
233 | END _mod2; |
||
234 | |||
235 | |||
236 | PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); |
||
6613 | leency | 237 | BEGIN |
7597 | akron1 | 238 | ptr := API._NEW(size); |
239 | IF ptr # 0 THEN |
||
240 | SYSTEM.PUT(ptr, t); |
||
241 | INC(ptr, SIZE_OF_DWORD) |
||
242 | END |
||
243 | END _new; |
||
6613 | leency | 244 | |
7597 | akron1 | 245 | |
246 | PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER); |
||
6613 | leency | 247 | BEGIN |
7597 | akron1 | 248 | IF ptr # 0 THEN |
249 | ptr := API._DISPOSE(ptr - SIZE_OF_DWORD) |
||
250 | END |
||
251 | END _dispose; |
||
252 | |||
253 | |||
254 | PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; |
||
255 | VAR |
||
256 | A, B: CHAR; |
||
257 | res: INTEGER; |
||
258 | |||
259 | BEGIN |
||
260 | res := 0; |
||
261 | WHILE n > 0 DO |
||
262 | SYSTEM.GET(a, A); INC(a); |
||
263 | SYSTEM.GET(b, B); INC(b); |
||
264 | DEC(n); |
||
265 | IF A # B THEN |
||
266 | res := ORD(A) - ORD(B); |
||
267 | n := 0 |
||
268 | ELSIF A = 0X THEN |
||
269 | n := 0 |
||
270 | END |
||
271 | END |
||
272 | RETURN res |
||
273 | END strncmp; |
||
274 | |||
275 | |||
276 | PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; |
||
277 | VAR |
||
278 | A, B: WCHAR; |
||
279 | res: INTEGER; |
||
280 | |||
281 | BEGIN |
||
282 | res := 0; |
||
283 | WHILE n > 0 DO |
||
284 | SYSTEM.GET(a, A); INC(a, 2); |
||
285 | SYSTEM.GET(b, B); INC(b, 2); |
||
286 | DEC(n); |
||
287 | IF A # B THEN |
||
288 | res := ORD(A) - ORD(B); |
||
289 | n := 0 |
||
290 | ELSIF A = 0X THEN |
||
291 | n := 0 |
||
292 | END |
||
293 | END |
||
294 | RETURN res |
||
295 | END strncmpw; |
||
296 | |||
297 | |||
298 | PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; |
||
299 | BEGIN |
||
300 | SYSTEM.CODE( |
||
301 | |||
302 | 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) |
||
303 | 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) |
||
304 | 048H, (* dec eax *) |
||
305 | (* L1: *) |
||
306 | 040H, (* inc eax *) |
||
307 | 080H, 038H, 000H, (* cmp byte [eax], 0 *) |
||
308 | 074H, 003H, (* jz L2 *) |
||
309 | 0E2H, 0F8H, (* loop L1 *) |
||
310 | 040H, (* inc eax *) |
||
311 | (* L2: *) |
||
312 | 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *) |
||
313 | 0C9H, (* leave *) |
||
314 | 0C2H, 008H, 000H (* ret 08h *) |
||
315 | ) |
||
316 | |||
317 | RETURN 0 |
||
6613 | leency | 318 | END _length; |
319 | |||
7597 | akron1 | 320 | |
321 | PROCEDURE [stdcall] _lengthw* (len, str: INTEGER): INTEGER; |
||
6613 | leency | 322 | BEGIN |
7597 | akron1 | 323 | SYSTEM.CODE( |
6613 | leency | 324 | |
7597 | akron1 | 325 | 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) |
326 | 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) |
||
327 | 048H, (* dec eax *) |
||
328 | 048H, (* dec eax *) |
||
329 | (* L1: *) |
||
330 | 040H, (* inc eax *) |
||
331 | 040H, (* inc eax *) |
||
332 | 066H, 083H, 038H, 000H, (* cmp word [eax], 0 *) |
||
333 | 074H, 004H, (* jz L2 *) |
||
334 | 0E2H, 0F6H, (* loop L1 *) |
||
335 | 040H, (* inc eax *) |
||
336 | 040H, (* inc eax *) |
||
337 | (* L2: *) |
||
338 | 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *) |
||
339 | 0D1H, 0E8H, (* shr eax, 1 *) |
||
340 | 0C9H, (* leave *) |
||
341 | 0C2H, 008H, 000H (* ret 08h *) |
||
342 | ) |
||
343 | |||
344 | RETURN 0 |
||
345 | END _lengthw; |
||
346 | |||
347 | |||
348 | PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; |
||
349 | VAR |
||
350 | res: INTEGER; |
||
351 | bRes: BOOLEAN; |
||
352 | |||
6613 | leency | 353 | BEGIN |
7597 | akron1 | 354 | |
355 | res := strncmp(str1, str2, MIN(len1, len2)); |
||
356 | IF res = 0 THEN |
||
357 | res := _length(len1, str1) - _length(len2, str2) |
||
358 | END; |
||
359 | |||
360 | CASE op OF |
||
361 | |0: bRes := res = 0 |
||
362 | |1: bRes := res # 0 |
||
363 | |2: bRes := res < 0 |
||
364 | |3: bRes := res <= 0 |
||
365 | |4: bRes := res > 0 |
||
366 | |5: bRes := res >= 0 |
||
367 | END |
||
368 | |||
369 | RETURN bRes |
||
6613 | leency | 370 | END _strcmp; |
371 | |||
7597 | akron1 | 372 | |
373 | PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; |
||
374 | RETURN _strcmp(op, len2, str2, len1, str1) |
||
375 | END _strcmp2; |
||
376 | |||
377 | |||
378 | PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; |
||
379 | VAR |
||
380 | res: INTEGER; |
||
381 | bRes: BOOLEAN; |
||
382 | |||
6613 | leency | 383 | BEGIN |
384 | |||
7597 | akron1 | 385 | res := strncmpw(str1, str2, MIN(len1, len2)); |
386 | IF res = 0 THEN |
||
387 | res := _lengthw(len1, str1) - _lengthw(len2, str2) |
||
388 | END; |
||
389 | |||
390 | CASE op OF |
||
391 | |0: bRes := res = 0 |
||
392 | |1: bRes := res # 0 |
||
393 | |2: bRes := res < 0 |
||
394 | |3: bRes := res <= 0 |
||
395 | |4: bRes := res > 0 |
||
396 | |5: bRes := res >= 0 |
||
397 | END |
||
398 | |||
399 | RETURN bRes |
||
400 | END _strcmpw; |
||
401 | |||
402 | |||
403 | PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; |
||
404 | RETURN _strcmpw(op, len2, str2, len1, str1) |
||
405 | END _strcmpw2; |
||
406 | |||
407 | |||
408 | PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); |
||
409 | VAR |
||
410 | c: CHAR; |
||
411 | i: INTEGER; |
||
412 | |||
6613 | leency | 413 | BEGIN |
7597 | akron1 | 414 | i := 0; |
415 | REPEAT |
||
416 | SYSTEM.GET(pchar, c); |
||
417 | s[i] := c; |
||
418 | INC(pchar); |
||
419 | INC(i) |
||
420 | UNTIL c = 0X |
||
421 | END PCharToStr; |
||
6613 | leency | 422 | |
7597 | akron1 | 423 | |
424 | PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR); |
||
425 | VAR |
||
426 | i, a, b: INTEGER; |
||
427 | c: CHAR; |
||
428 | |||
6613 | leency | 429 | BEGIN |
430 | |||
7597 | akron1 | 431 | i := 0; |
432 | REPEAT |
||
433 | str[i] := CHR(x MOD 10 + ORD("0")); |
||
434 | x := x DIV 10; |
||
435 | INC(i) |
||
436 | UNTIL x = 0; |
||
6613 | leency | 437 | |
7597 | akron1 | 438 | a := 0; |
439 | b := i - 1; |
||
440 | WHILE a < b DO |
||
441 | c := str[a]; |
||
442 | str[a] := str[b]; |
||
443 | str[b] := c; |
||
444 | INC(a); |
||
445 | DEC(b) |
||
446 | END; |
||
447 | str[i] := 0X |
||
448 | END IntToStr; |
||
449 | |||
450 | |||
451 | PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); |
||
452 | VAR |
||
453 | n1, n2, i, j: INTEGER; |
||
454 | BEGIN |
||
455 | n1 := LENGTH(s1); |
||
456 | n2 := LENGTH(s2); |
||
457 | |||
458 | ASSERT(n1 + n2 < LEN(s1)); |
||
459 | |||
6613 | leency | 460 | i := 0; |
7597 | akron1 | 461 | j := n1; |
462 | WHILE i < n2 DO |
||
463 | s1[j] := s2[i]; |
||
464 | INC(i); |
||
465 | INC(j) |
||
466 | END; |
||
467 | |||
468 | s1[j] := 0X |
||
469 | |||
470 | END append; |
||
471 | |||
472 | |||
473 | PROCEDURE [stdcall] _error* (module, err: INTEGER); |
||
474 | VAR |
||
475 | s, temp: ARRAY 1024 OF CHAR; |
||
476 | |||
477 | BEGIN |
||
478 | |||
479 | s := ""; |
||
480 | CASE err MOD 16 OF |
||
481 | | 1: append(s, "assertion failure") |
||
482 | | 2: append(s, "NIL dereference") |
||
483 | | 3: append(s, "division by zero") |
||
484 | | 4: append(s, "NIL procedure call") |
||
485 | | 5: append(s, "type guard error") |
||
486 | | 6: append(s, "index out of range") |
||
487 | | 7: append(s, "invalid CASE") |
||
488 | | 8: append(s, "array assignment error") |
||
489 | | 9: append(s, "CHR out of range") |
||
490 | |10: append(s, "WCHR out of range") |
||
491 | |11: append(s, "BYTE out of range") |
||
492 | END; |
||
493 | |||
494 | append(s, API.eol); |
||
495 | |||
496 | append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); |
||
497 | append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp); |
||
498 | |||
499 | API.DebugMsg(SYSTEM.ADR(s[0]), name); |
||
500 | |||
501 | API.exit_thread(0) |
||
502 | END _error; |
||
503 | |||
504 | |||
505 | PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN; |
||
506 | BEGIN |
||
507 | (* r IS t0 *) |
||
508 | |||
509 | WHILE (t1 # 0) & (t1 # t0) DO |
||
510 | SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
||
6613 | leency | 511 | END |
512 | |||
7597 | akron1 | 513 | RETURN t1 = t0 |
514 | END _isrec; |
||
515 | |||
516 | |||
517 | PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN; |
||
518 | VAR |
||
519 | t1: INTEGER; |
||
520 | |||
6613 | leency | 521 | BEGIN |
7597 | akron1 | 522 | (* p IS t0 *) |
6613 | leency | 523 | |
7597 | akron1 | 524 | IF p # 0 THEN |
525 | DEC(p, SIZE_OF_DWORD); |
||
526 | SYSTEM.GET(p, t1); |
||
527 | WHILE (t1 # 0) & (t1 # t0) DO |
||
528 | SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
||
529 | END |
||
530 | ELSE |
||
531 | t1 := -1 |
||
532 | END |
||
533 | |||
534 | RETURN t1 = t0 |
||
535 | END _is; |
||
536 | |||
537 | |||
538 | PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN; |
||
6613 | leency | 539 | BEGIN |
7597 | akron1 | 540 | (* r:t1 IS t0 *) |
6613 | leency | 541 | |
7597 | akron1 | 542 | WHILE (t1 # 0) & (t1 # t0) DO |
543 | SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
||
544 | END |
||
545 | |||
546 | RETURN t1 = t0 |
||
547 | END _guardrec; |
||
548 | |||
549 | |||
550 | PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN; |
||
551 | VAR |
||
552 | t1: INTEGER; |
||
553 | |||
6613 | leency | 554 | BEGIN |
7597 | akron1 | 555 | (* p IS t0 *) |
556 | SYSTEM.GET(p, p); |
||
557 | IF p # 0 THEN |
||
558 | DEC(p, SIZE_OF_DWORD); |
||
559 | SYSTEM.GET(p, t1); |
||
560 | WHILE (t1 # t0) & (t1 # 0) DO |
||
561 | SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) |
||
562 | END |
||
563 | ELSE |
||
564 | t1 := t0 |
||
565 | END |
||
6613 | leency | 566 | |
7597 | akron1 | 567 | RETURN t1 = t0 |
568 | END _guard; |
||
569 | |||
570 | |||
571 | PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; |
||
572 | VAR |
||
573 | res: INTEGER; |
||
574 | |||
6613 | leency | 575 | BEGIN |
7597 | akron1 | 576 | CASE fdwReason OF |
577 | |DLL_PROCESS_ATTACH: |
||
578 | res := 1 |
||
579 | |DLL_THREAD_ATTACH: |
||
580 | res := 0; |
||
581 | IF dll.thread_attach # NIL THEN |
||
582 | dll.thread_attach(hinstDLL, fdwReason, lpvReserved) |
||
583 | END |
||
584 | |DLL_THREAD_DETACH: |
||
585 | res := 0; |
||
586 | IF dll.thread_detach # NIL THEN |
||
587 | dll.thread_detach(hinstDLL, fdwReason, lpvReserved) |
||
588 | END |
||
589 | |DLL_PROCESS_DETACH: |
||
590 | res := 0; |
||
591 | IF dll.process_detach # NIL THEN |
||
592 | dll.process_detach(hinstDLL, fdwReason, lpvReserved) |
||
593 | END |
||
594 | ELSE |
||
595 | res := 0 |
||
596 | END |
||
6613 | leency | 597 | |
7597 | akron1 | 598 | RETURN res |
599 | END _dllentry; |
||
600 | |||
601 | |||
602 | PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY); |
||
603 | BEGIN |
||
604 | dll.process_detach := process_detach; |
||
605 | dll.thread_detach := thread_detach; |
||
606 | dll.thread_attach := thread_attach |
||
607 | END SetDll; |
||
608 | |||
609 | |||
610 | PROCEDURE [stdcall] _exit* (code: INTEGER); |
||
611 | BEGIN |
||
612 | API.exit(code) |
||
613 | END _exit; |
||
614 | |||
615 | |||
616 | PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER); |
||
617 | BEGIN |
||
618 | SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *) |
||
619 | API.init(param, code); |
||
620 | |||
621 | types := _types; |
||
622 | name := modname; |
||
623 | |||
624 | dll.process_detach := NIL; |
||
625 | dll.thread_detach := NIL; |
||
626 | dll.thread_attach := NIL; |
||
627 | END _init; |
||
628 | |||
629 | |||
6613 | leency | 630 | END RTL.>>>=>>=>>>>>>>=>=>> |