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