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