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