Subversion Repositories Kolibri OS

Rev

Rev 7696 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 7696 Rev 7983
Line 1... Line 1...
1 
(*
 1 
(*
2 
    BSD 2-Clause License
 2 
    BSD 2-Clause License
Line 3... Line 3...
3 
 
 3 
 
4 
    Copyright (c) 2018-2019, Anton Krotov
 4 
    Copyright (c) 2018-2020, Anton Krotov
5 
    All rights reserved.
 5 
    All rights reserved.
Line 6... Line 6...
6 
*)
 6 
*)
Line 14... Line 14...
14 
 
 14 
 
15 
    bit_depth* = 32;
 15 
    bit_depth* = 32;
16 
    maxint* = 7FFFFFFFH;
 16 
    maxint* = 7FFFFFFFH;
Line 17... Line -...
17 
    minint* = 80000000H;
 - 
 
18 
 
 - 
 
19 
    DLL_PROCESS_ATTACH = 1;
 - 
 
20 
    DLL_THREAD_ATTACH  = 2;
 - 
 
21 
    DLL_THREAD_DETACH  = 3;
 - 
 
22 
    DLL_PROCESS_DETACH = 0;
 17 
    minint* = 80000000H;
23 
 
 18 
 
Line 24... Line -...
24 
    WORD = bit_depth DIV 8;
 - 
 
25 
    MAX_SET = bit_depth - 1;
 - 
 
26 
 
 - 
 
27 
 
 - 
 
28 
TYPE
 - 
 
29 
 
 - 
 
30 
    DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
 19 
    WORD = bit_depth DIV 8;
Line 31... Line 20...
31 
    PROC       = PROCEDURE;
 20 
    MAX_SET = bit_depth - 1;
32 
 
 21 
 
33 
 
 - 
 
34 
VAR
 - 
 
35 
 
 - 
 
36 
    name:  INTEGER;
 - 
 
37 
    types: INTEGER;
 - 
 
38 
    bits:  ARRAY MAX_SET + 1 OF INTEGER;
 - 
 
39 
 
 - 
 
40 
    dll: RECORD
 - 
 
41 
        process_detach,
 - 
 
Line 42... Line 22...
42 
        thread_detach,
 22 
 
43 
        thread_attach: DLL_ENTRY
 23 
VAR
44 
    END;
 24 
 
Line 95... Line 75...
95 
PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
 75 
PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
96 
VAR
 76 
VAR
97 
    i, n, k: INTEGER;
 77 
    i, n, k: INTEGER;
Line 98... Line 78...
98 
 
 78 
 
99 
BEGIN
 - 
 
100 
 
 79 
BEGIN
101 
    k := LEN(A) - 1;
 80 
    k := LEN(A) - 1;
102 
    n := A[0];
 81 
    n := A[0];
103 
    i := 0;
 82 
    i := 0;
104 
    WHILE i < k DO
 83 
    WHILE i < k DO
105 
        A[i] := A[i + 1];
 84 
        A[i] := A[i + 1];
106 
        INC(i)
 85 
        INC(i)
107 
    END;
 86 
    END;
108 
    A[k] := n
 - 
 
109 
 
 87 
    A[k] := n
Line 110... Line 88...
110 
END _rot;
 88 
END _rot;
111 
 
 89 
 
Line 126... Line 104...
126 
 
 104 
 
127 
    RETURN a
 105 
    RETURN a
Line 128... Line 106...
128 
END _set;
 106 
END _set;
129 
 
 107 
 
130 
 
 108 
 
131 
PROCEDURE [stdcall] _set1* (a: INTEGER): INTEGER;
 109 
PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *)
- 
 
 110 
BEGIN
- 
 
 111 
    SYSTEM.CODE(
132 
BEGIN
 112 
    031H, 0C0H,         (*  xor  eax, eax              *)
- 
 
 113 
    08BH, 04DH, 008H,   (*  mov  ecx, dword [ebp + 8]  *)  (* ecx <- a *)
133 
    IF ASR(a, 5) = 0 THEN
 114 
    083H, 0F9H, 01FH,   (*  cmp  ecx, 31               *)
134 
        SYSTEM.GET(SYSTEM.ADR(bits[0]) + a * WORD, a)
 115 
    077H, 003H,         (*  ja   L                     *)
135 
    ELSE
 - 
 
136 
        a := 0
 116 
    00FH, 0ABH, 0C8H    (*  bts  eax, ecx              *)
Line 137... Line 117...
137 
    END
 117 
                        (*  L:                         *)
138 
    RETURN a
 118 
    )
Line 313... Line 293...
313 
    res:  INTEGER;
 293 
    res:  INTEGER;
314 
    bRes: BOOLEAN;
 294 
    bRes: BOOLEAN;
315 
    c:    CHAR;
 295 
    c:    CHAR;
Line 316... Line 296...
316 
 
 296 
 
317 
BEGIN
 - 
 
318 
 
 297 
BEGIN
319 
    res := strncmp(str1, str2, MIN(len1, len2));
 298 
    res := strncmp(str1, str2, MIN(len1, len2));
320 
    IF res = minint THEN
 299 
    IF res = minint THEN
321 
        IF len1 > len2 THEN
 300 
        IF len1 > len2 THEN
322 
            SYSTEM.GET(str1 + len2, c);
 301 
            SYSTEM.GET(str1 + len2, c);
Line 347... Line 326...
347 
    res:  INTEGER;
 326 
    res:  INTEGER;
348 
    bRes: BOOLEAN;
 327 
    bRes: BOOLEAN;
349 
    c:    WCHAR;
 328 
    c:    WCHAR;
Line 350... Line 329...
350 
 
 329 
 
351 
BEGIN
 - 
 
352 
 
 330 
BEGIN
353 
    res := strncmpw(str1, str2, MIN(len1, len2));
 331 
    res := strncmpw(str1, str2, MIN(len1, len2));
354 
    IF res = minint THEN
 332 
    IF res = minint THEN
355 
        IF len1 > len2 THEN
 333 
        IF len1 > len2 THEN
356 
            SYSTEM.GET(str1 + len2 * 2, c);
 334 
            SYSTEM.GET(str1 + len2 * 2, c);
Line 396... Line 374...
396 
VAR
 374 
VAR
397 
    i, a, b: INTEGER;
 375 
    i, a, b: INTEGER;
398 
    c: CHAR;
 376 
    c: CHAR;
Line 399... Line 377...
399 
 
 377 
 
400 
BEGIN
 - 
 
401 
 
 378 
BEGIN
402 
    i := 0;
 379 
    i := 0;
403 
    REPEAT
 380 
    REPEAT
404 
        str[i] := CHR(x MOD 10 + ORD("0"));
 381 
        str[i] := CHR(x MOD 10 + ORD("0"));
405 
        x := x DIV 10;
 382 
        x := x DIV 10;
Line 420... Line 397...
420 
 
 397 
 
421 
 
 398 
 
422 
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
 399 
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
- 
 
 400 
VAR
423 
VAR
 401 
    n1, n2, i, j: INTEGER;
424 
    n1, n2, i, j: INTEGER;
 402 
 
425 
BEGIN
 403 
BEGIN
Line 426... Line 404...
426 
    n1 := LENGTH(s1);
 404 
    n1 := LENGTH(s1);
Line 435... Line 413...
435 
        INC(i);
 413 
        INC(i);
436 
        INC(j)
 414 
        INC(j)
437 
    END;
 415 
    END;
Line 438... Line 416...
438 
 
 416 
 
439 
    s1[j] := 0X
 - 
 
440 
 
 417 
    s1[j] := 0X
Line 441... Line 418...
441 
END append;
 418 
END append;
442 
 
 419 
 
443 
 
 420 
 
Line 444... Line 421...
444 
PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
 421 
PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
445 
VAR
 - 
 
446 
    s, temp: ARRAY 1024 OF CHAR;
 - 
 
447 
 
 422 
VAR
448 
BEGIN
 423 
    s, temp: ARRAY 1024 OF CHAR;
449 
 
 424 
 
450 
    s := "";
 425 
BEGIN
451 
    CASE err OF
 426 
    CASE err OF
452 
    | 1: append(s, "assertion failure")
 427 
    | 1: s := "assertion failure"
453 
    | 2: append(s, "NIL dereference")
 428 
    | 2: s := "NIL dereference"
454 
    | 3: append(s, "division by zero")
 429 
    | 3: s := "bad divisor"
455 
    | 4: append(s, "NIL procedure call")
 430 
    | 4: s := "NIL procedure call"
456 
    | 5: append(s, "type guard error")
 431 
    | 5: s := "type guard error"
457 
    | 6: append(s, "index out of range")
 432 
    | 6: s := "index out of range"
458 
    | 7: append(s, "invalid CASE")
 433 
    | 7: s := "invalid CASE"
459 
    | 8: append(s, "array assignment error")
 434 
    | 8: s := "array assignment error"
Line 460... Line 435...
460 
    | 9: append(s, "CHR out of range")
 435 
    | 9: s := "CHR out of range"
Line 461... Line 436...
461 
    |10: append(s, "WCHR out of range")
 436 
    |10: s := "WCHR out of range"
Line 511... Line 486...
511 
    RETURN p MOD 2
 486 
    RETURN p MOD 2
512 
END _guard;
 487 
END _guard;
Line 513... Line 488...
513 
 
 488 
 
514 
 
 - 
 
- 
 
 489 
 
515 
PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
 490 
PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
Line 516... Line -...
516 
VAR
 - 
 
517 
    res: INTEGER;
 - 
 
518 
 
 - 
 
519 
BEGIN
 - 
 
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
 - 
 
Line -... Line 491...
- 
 
 491 
    RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
- 
 
 492 
END _dllentry;
538 
    ELSE
 493 
 
539 
        res := 0
 494 
 
Line 540... Line 495...
540 
    END
 495 
PROCEDURE [stdcall] _sofinit*;
541 
 
 496 
BEGIN
542 
    RETURN res
 497 
    API.sofinit
Line 569... Line 524...
569 
 
 524 
 
570 
            SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
 525 
            SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
571 
        END
 526 
        END
Line 572... Line -...
572 
    END;
 - 
 
573 
 
 - 
 
574 
    j := 1;
 - 
 
575 
    FOR i := 0 TO MAX_SET DO
 - 
 
576 
        bits[i] := j;
 - 
 
577 
        j := LSL(j, 1)
 - 
 
578 
    END;
 527 
    END;
579 
 
 - 
 
580 
    name := modname;
 - 
 
581 
 
 - 
 
582 
    dll.process_detach := NIL;
 - 
 
583 
    dll.thread_detach  := NIL;
 - 
 
584 
    dll.thread_attach  := NIL;
 - 
 
585 
 
 528 
 
Line 586... Line -...
586 
    fini := NIL
 - 
 
587 
END _init;
 - 
 
588 
 
 - 
 
589 
 
 - 
 
590 
PROCEDURE [stdcall] _sofinit*;
 - 
 
591 
BEGIN
 - 
 
592 
    IF fini # NIL THEN
 - 
 
593 
        fini
 - 
 
594 
    END
 - 
 
595 
END _sofinit;
 - 
 
596 
 
 - 
 
597 
 
 - 
 
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 
 
 - 
 
606 
PROCEDURE SetFini* (ProcFini: PROC);
 - 
 
607 
BEGIN
 - 
 
608 
    fini := ProcFini
 529 
    name := modname