Subversion Repositories Kolibri OS

Rev

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