Subversion Repositories Kolibri OS

Rev

Rev 7696 | Go to most recent revision | Blame | Last modification | View Log | Download | RSS feed

  1. (*
  2.     BSD 2-Clause License
  3.  
  4.     Copyright (c) 2018-2020, Anton Krotov
  5.     All rights reserved.
  6. *)
  7.  
  8. MODULE RTL;
  9.  
  10. IMPORT SYSTEM, API;
  11.  
  12.  
  13. CONST
  14.  
  15.     bit_depth* = 32;
  16.     maxint* = 7FFFFFFFH;
  17.     minint* = 80000000H;
  18.  
  19.     WORD = bit_depth DIV 8;
  20.     MAX_SET = bit_depth - 1;
  21.  
  22.  
  23. VAR
  24.  
  25.     name:  INTEGER;
  26.     types: INTEGER;
  27.  
  28.  
  29. PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER);
  30. BEGIN
  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.                 )
  50. END _move;
  51.  
  52.  
  53. PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
  54. VAR
  55.     res: BOOLEAN;
  56.  
  57. BEGIN
  58.     IF len_src > len_dst THEN
  59.         res := FALSE
  60.     ELSE
  61.         _move(len_src * base_size, dst, src);
  62.         res := TRUE
  63.     END
  64.  
  65.     RETURN res
  66. END _arrcpy;
  67.  
  68.  
  69. PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
  70. BEGIN
  71.     _move(MIN(len_dst, len_src) * chr_size, dst, src)
  72. END _strcpy;
  73.  
  74.  
  75. PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
  76. VAR
  77.     i, n, k: INTEGER;
  78.  
  79. BEGIN
  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.  
  91. PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
  92. BEGIN
  93.     IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
  94.         IF b > MAX_SET THEN
  95.             b := MAX_SET
  96.         END;
  97.         IF a < 0 THEN
  98.             a := 0
  99.         END;
  100.         a := LSR(ASR(minint, b - a), MAX_SET - b)
  101.     ELSE
  102.         a := 0
  103.     END
  104.  
  105.     RETURN a
  106. END _set;
  107.  
  108.  
  109. PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *)
  110. BEGIN
  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.     )
  119. END _set1;
  120.  
  121.  
  122. PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
  123. BEGIN
  124.     SYSTEM.CODE(
  125.     053H,                (*  push    ebx                    *)
  126.     08BH, 045H, 00CH,    (*  mov     eax, dword [ebp + 12]  *)  (* eax <- x *)
  127.     031H, 0D2H,          (*  xor     edx, edx               *)
  128.     085H, 0C0H,          (*  test    eax, eax               *)
  129.     074H, 018H,          (*  je      L2                     *)
  130.     07FH, 002H,          (*  jg      L1                     *)
  131.     0F7H, 0D2H,          (*  not     edx                    *)
  132.                          (*  L1:                            *)
  133.     089H, 0C3H,          (*  mov     ebx, eax               *)
  134.     08BH, 04DH, 008H,    (*  mov     ecx, dword [ebp + 8]   *)  (* ecx <- y *)
  135.     0F7H, 0F9H,          (*  idiv    ecx                    *)
  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                    *)
  145.                )
  146. END _divmod;
  147.  
  148.  
  149. PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
  150. BEGIN
  151.     ptr := API._NEW(size);
  152.     IF ptr # 0 THEN
  153.         SYSTEM.PUT(ptr, t);
  154.         INC(ptr, WORD)
  155.     END
  156. END _new;
  157.  
  158.  
  159. PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
  160. BEGIN
  161.     IF ptr # 0 THEN
  162.         ptr := API._DISPOSE(ptr - WORD)
  163.     END
  164. END _dispose;
  165.  
  166.  
  167. PROCEDURE [stdcall] _length* (len, str: INTEGER);
  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:                             *)
  180.     02BH, 045H, 00CH     (*  sub     eax, dword [ebp + 0Ch]  *)
  181.                )
  182. END _length;
  183.  
  184.  
  185. PROCEDURE [stdcall] _lengthw* (len, str: INTEGER);
  186. BEGIN
  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]  *)
  202.     0D1H, 0E8H                (*  shr     eax, 1                  *)
  203.                )
  204. END _lengthw;
  205.  
  206.  
  207. PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER;
  208. BEGIN
  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
  245. END strncmp;
  246.  
  247.  
  248. PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER;
  249. BEGIN
  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
  288. END strncmpw;
  289.  
  290.  
  291. PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
  292. VAR
  293.     res:  INTEGER;
  294.     bRes: BOOLEAN;
  295.     c:    CHAR;
  296.  
  297. BEGIN
  298.     res := strncmp(str1, str2, MIN(len1, len2));
  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
  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
  321. END _strcmp;
  322.  
  323.  
  324. PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
  325. VAR
  326.     res:  INTEGER;
  327.     bRes: BOOLEAN;
  328.     c:    WCHAR;
  329.  
  330. BEGIN
  331.     res := strncmpw(str1, str2, MIN(len1, len2));
  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
  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.  
  362. BEGIN
  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;
  371.  
  372.  
  373. PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
  374. VAR
  375.     i, a, b: INTEGER;
  376.     c: CHAR;
  377.  
  378. BEGIN
  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;
  385.  
  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;
  402.  
  403. BEGIN
  404.     n1 := LENGTH(s1);
  405.     n2 := LENGTH(s2);
  406.  
  407.     ASSERT(n1 + n2 < LEN(s1));
  408.  
  409.     i := 0;
  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.  
  421. PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
  422. VAR
  423.     s, temp: ARRAY 1024 OF CHAR;
  424.  
  425. BEGIN
  426.     CASE err OF
  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"
  438.     END;
  439.  
  440.     append(s, API.eol);
  441.  
  442.     append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
  443.     append(s, "line: ");   IntToStr(line, temp);     append(s, temp);
  444.  
  445.     API.DebugMsg(SYSTEM.ADR(s[0]), name);
  446.  
  447.     API.exit_thread(0)
  448. END _error;
  449.  
  450.  
  451. PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
  452. BEGIN
  453.     SYSTEM.GET(t0 + t1 + types, t0)
  454.     RETURN t0 MOD 2
  455. END _isrec;
  456.  
  457.  
  458. PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
  459. BEGIN
  460.     IF p # 0 THEN
  461.         SYSTEM.GET(p - WORD, p);
  462.         SYSTEM.GET(t0 + p + types, p)
  463.     END
  464.  
  465.     RETURN p MOD 2
  466. END _is;
  467.  
  468.  
  469. PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
  470. BEGIN
  471.     SYSTEM.GET(t0 + t1 + types, t0)
  472.     RETURN t0 MOD 2
  473. END _guardrec;
  474.  
  475.  
  476. PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
  477. BEGIN
  478.     SYSTEM.GET(p, p);
  479.     IF p # 0 THEN
  480.         SYSTEM.GET(p - WORD, p);
  481.         SYSTEM.GET(t0 + p + types, p)
  482.     ELSE
  483.         p := 1
  484.     END
  485.  
  486.     RETURN p MOD 2
  487. END _guard;
  488.  
  489.  
  490. PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
  491.     RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
  492. END _dllentry;
  493.  
  494.  
  495. PROCEDURE [stdcall] _sofinit*;
  496. BEGIN
  497.     API.sofinit
  498. END _sofinit;
  499.  
  500.  
  501. PROCEDURE [stdcall] _exit* (code: INTEGER);
  502. BEGIN
  503.     API.exit(code)
  504. END _exit;
  505.  
  506.  
  507. PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
  508. VAR
  509.     t0, t1, i, j: INTEGER;
  510.  
  511. BEGIN
  512.     SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
  513.     API.init(param, code);
  514.  
  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
  522.                 SYSTEM.GET(_types + t1 * WORD, t1)
  523.             END;
  524.  
  525.             SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
  526.         END
  527.     END;
  528.  
  529.     name := modname
  530. END _init;
  531.  
  532.  
  533. END RTL.