Subversion Repositories Kolibri OS

Rev

Rev 7983 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
7983 leency 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
8097 maxcodehac 353
    i, a: INTEGER;
7983 leency 354
 
355
BEGIN
356
    i := 0;
8097 maxcodehac 357
    a := x;
7983 leency 358
    REPEAT
8097 maxcodehac 359
        INC(i);
360
        a := a DIV 10
361
    UNTIL a = 0;
362
 
363
    str[i] := 0X;
364
 
365
    REPEAT
366
        DEC(i);
7983 leency 367
        str[i] := CHR(x MOD 10 + ORD("0"));
8097 maxcodehac 368
        x := x DIV 10
369
    UNTIL x = 0
7983 leency 370
END IntToStr;
371
 
372
 
373
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
374
VAR
8097 maxcodehac 375
    n1, n2: INTEGER;
7983 leency 376
 
377
BEGIN
378
    n1 := LENGTH(s1);
379
    n2 := LENGTH(s2);
380
 
381
    ASSERT(n1 + n2 < LEN(s1));
382
 
8097 maxcodehac 383
    SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
384
    s1[n1 + n2] := 0X
7983 leency 385
END append;
386
 
387
 
8097 maxcodehac 388
PROCEDURE [stdcall64] _error* (modnum, _module, err, line: INTEGER);
7983 leency 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
 
8097 maxcodehac 407
    append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
408
    append(s, API.eol + "line: ");   IntToStr(line, temp);     append(s, temp);
7983 leency 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.