WebSVN – Kolibri OS – Diff – /programs/develop/oberon07/Lib/KolibriOS/RTL.ob07


﻿(*
    BSD 2-Clause License
 
    Copyright (c) 2018-2020, Anton Krotov
    All rights reserved.
*)
 
MODULE RTL;
 
IMPORT SYSTEM, API;
 
 
CONST
 
    bit_depth* = 32;
    maxint* = 7FFFFFFFH;
    minint* = 80000000H;
 
 
 
 
 
 
    WORD = bit_depth DIV 8;
    MAX_SET = bit_depth - 1;
 
 
 
 
 
 
 
 
VAR
 
    name:  INTEGER;
    types: INTEGER;
 
 
 
 
 
 
 
 
 
 
 
PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER);
BEGIN
    SYSTEM.CODE(
    08BH, 045H, 008H,    (*  mov eax, dword [ebp + 8]   *)
    085H, 0C0H,          (*  test eax, eax              *)
    07EH, 019H,          (*  jle L                      *)
    0FCH,                (*  cld                        *)
    057H,                (*  push edi                   *)
    056H,                (*  push esi                   *)
    08BH, 075H, 010H,    (*  mov esi, dword [ebp + 16]  *)
    08BH, 07DH, 00CH,    (*  mov edi, dword [ebp + 12]  *)
    089H, 0C1H,          (*  mov ecx, eax               *)
    0C1H, 0E9H, 002H,    (*  shr ecx, 2                 *)
    0F3H, 0A5H,          (*  rep movsd                  *)
    089H, 0C1H,          (*  mov ecx, eax               *)
    083H, 0E1H, 003H,    (*  and ecx, 3                 *)
    0F3H, 0A4H,          (*  rep movsb                  *)
    05EH,                (*  pop esi                    *)
    05FH                 (*  pop edi                    *)
                         (*  L:                         *)
                )
END _move;
 
 
PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN;
VAR
    res: BOOLEAN;
 
BEGIN
    IF len_src > len_dst THEN
        res := FALSE
    ELSE
        _move(len_src * base_size, dst, src);
        res := TRUE
    END
 
    RETURN res
END _arrcpy;
 
 
PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
BEGIN
    _move(MIN(len_dst, len_src) * chr_size, dst, src)
END _strcpy;
 
 
PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER);
VAR
    i, n, k: INTEGER;
 
BEGIN
 
    k := LEN(A) - 1;
    n := A[0];
    i := 0;
    WHILE i < k DO
        A[i] := A[i + 1];
        INC(i)
    END;
    A[k] := n
 
END _rot;
 
 
PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
BEGIN
    IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
        IF b > MAX_SET THEN
            b := MAX_SET
        END;
        IF a < 0 THEN
            a := 0
        END;
        a := LSR(ASR(minint, b - a), MAX_SET - b)
    ELSE
        a := 0
    END
 
    RETURN a
END _set;
 
 
PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *)
BEGIN
    SYSTEM.CODE(
    031H, 0C0H,         (*  xor  eax, eax              *)
    08BH, 04DH, 008H,   (*  mov  ecx, dword [ebp + 8]  *)  (* ecx <- a *)
    083H, 0F9H, 01FH,   (*  cmp  ecx, 31               *)
    077H, 003H,         (*  ja   L                     *)
    00FH, 0ABH, 0C8H    (*  bts  eax, ecx              *)
                        (*  L:                         *)
 
    )
END _set1;
 
 
PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
BEGIN
    SYSTEM.CODE(
    053H,                (*  push    ebx                    *)
    08BH, 045H, 00CH,    (*  mov     eax, dword [ebp + 12]  *)  (* eax <- x *)
    031H, 0D2H,          (*  xor     edx, edx               *)
    085H, 0C0H,          (*  test    eax, eax               *)
    074H, 018H,          (*  je      L2                     *)
    07FH, 002H,          (*  jg      L1                     *)
    0F7H, 0D2H,          (*  not     edx                    *)
                         (*  L1:                            *)
    089H, 0C3H,          (*  mov     ebx, eax               *)
    08BH, 04DH, 008H,    (*  mov     ecx, dword [ebp + 8]   *)  (* ecx <- y *)
    0F7H, 0F9H,          (*  idiv    ecx                    *)
    085H, 0D2H,          (*  test    edx, edx               *)
    074H, 009H,          (*  je      L2                     *)
    031H, 0CBH,          (*  xor     ebx, ecx               *)
    085H, 0DBH,          (*  test    ebx, ebx               *)
    07DH, 003H,          (*  jge     L2                     *)
    048H,                (*  dec     eax                    *)
    001H, 0CAH,          (*  add     edx, ecx               *)
                         (*  L2:                            *)
    05BH                 (*  pop     ebx                    *)
               )
END _divmod;
 
 
PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
BEGIN
    ptr := API._NEW(size);
    IF ptr # 0 THEN
        SYSTEM.PUT(ptr, t);
        INC(ptr, WORD)
    END
END _new;
 
 
PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
BEGIN
    IF ptr # 0 THEN
        ptr := API._DISPOSE(ptr - WORD)
    END
END _dispose;
 
 
PROCEDURE [stdcall] _length* (len, str: INTEGER);
BEGIN
    SYSTEM.CODE(
    08BH, 045H, 00CH,    (*  mov     eax, dword [ebp + 0Ch]  *)
    08BH, 04DH, 008H,    (*  mov     ecx, dword [ebp + 08h]  *)
    048H,                (*  dec     eax                     *)
                         (*  L1:                             *)
    040H,                (*  inc     eax                     *)
    080H, 038H, 000H,    (*  cmp     byte [eax], 0           *)
    074H, 003H,          (*  jz      L2                      *)
    0E2H, 0F8H,          (*  loop    L1                      *)
    040H,                (*  inc     eax                     *)
                         (*  L2:                             *)
    02BH, 045H, 00CH     (*  sub     eax, dword [ebp + 0Ch]  *)
               )
END _length;
 
 
PROCEDURE [stdcall] _lengthw* (len, str: INTEGER);
BEGIN
    SYSTEM.CODE(
    08BH, 045H, 00CH,         (*  mov     eax, dword [ebp + 0Ch]  *)
    08BH, 04DH, 008H,         (*  mov     ecx, dword [ebp + 08h]  *)
    048H,                     (*  dec     eax                     *)
    048H,                     (*  dec     eax                     *)
                              (*  L1:                             *)
    040H,                     (*  inc     eax                     *)
    040H,                     (*  inc     eax                     *)
    066H, 083H, 038H, 000H,   (*  cmp     word [eax], 0           *)
    074H, 004H,               (*  jz      L2                      *)
    0E2H, 0F6H,               (*  loop    L1                      *)
    040H,                     (*  inc     eax                     *)
    040H,                     (*  inc     eax                     *)
                              (*  L2:                             *)
    02BH, 045H, 00CH,         (*  sub     eax, dword [ebp + 0Ch]  *)
    0D1H, 0E8H                (*  shr     eax, 1                  *)
               )
END _lengthw;
 
 
PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER;
BEGIN
    SYSTEM.CODE(
    056H,                    (*  push    esi                            *)
    057H,                    (*  push    edi                            *)
    053H,                    (*  push    ebx                            *)
    08BH, 075H, 008H,        (*  mov     esi, dword[ebp +  8]; esi <- a *)
    08BH, 07DH, 00CH,        (*  mov     edi, dword[ebp + 12]; edi <- b *)
    08BH, 05DH, 010H,        (*  mov     ebx, dword[ebp + 16]; ebx <- n *)
    031H, 0C9H,              (*  xor     ecx, ecx                       *)
    031H, 0D2H,              (*  xor     edx, edx                       *)
    0B8H,
    000H, 000H, 000H, 080H,  (*  mov     eax, minint                    *)
                             (*  L1:                                    *)
    085H, 0DBH,              (*  test    ebx, ebx                       *)
    07EH, 017H,              (*  jle     L3                             *)
    08AH, 00EH,              (*  mov     cl, byte[esi]                  *)
    08AH, 017H,              (*  mov     dl, byte[edi]                  *)
    046H,                    (*  inc     esi                            *)
    047H,                    (*  inc     edi                            *)
    04BH,                    (*  dec     ebx                            *)
    039H, 0D1H,              (*  cmp     ecx, edx                       *)
    074H, 006H,              (*  je      L2                             *)
    089H, 0C8H,              (*  mov     eax, ecx                       *)
    029H, 0D0H,              (*  sub     eax, edx                       *)
    0EBH, 006H,              (*  jmp     L3                             *)
                             (*  L2:                                    *)
    085H, 0C9H,              (*  test    ecx, ecx                       *)
    075H, 0E7H,              (*  jne     L1                             *)
    031H, 0C0H,              (*  xor     eax, eax                       *)
                             (*  L3:                                    *)
    05BH,                    (*  pop     ebx                            *)
    05FH,                    (*  pop     edi                            *)
    05EH,                    (*  pop     esi                            *)
    05DH,                    (*  pop     ebp                            *)
    0C2H, 00CH, 000H         (*  ret     12                             *)
    )
    RETURN 0
END strncmp;
 
 
PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER;
BEGIN
    SYSTEM.CODE(
    056H,                    (*  push    esi                            *)
    057H,                    (*  push    edi                            *)
    053H,                    (*  push    ebx                            *)
    08BH, 075H, 008H,        (*  mov     esi, dword[ebp +  8]; esi <- a *)
    08BH, 07DH, 00CH,        (*  mov     edi, dword[ebp + 12]; edi <- b *)
    08BH, 05DH, 010H,        (*  mov     ebx, dword[ebp + 16]; ebx <- n *)
    031H, 0C9H,              (*  xor     ecx, ecx                       *)
    031H, 0D2H,              (*  xor     edx, edx                       *)
    0B8H,
    000H, 000H, 000H, 080H,  (*  mov     eax, minint                    *)
                             (*  L1:                                    *)
    085H, 0DBH,              (*  test    ebx, ebx                       *)
    07EH, 01BH,              (*  jle     L3                             *)
    066H, 08BH, 00EH,        (*  mov     cx, word[esi]                  *)
    066H, 08BH, 017H,        (*  mov     dx, word[edi]                  *)
    046H,                    (*  inc     esi                            *)
    046H,                    (*  inc     esi                            *)
    047H,                    (*  inc     edi                            *)
    047H,                    (*  inc     edi                            *)
    04BH,                    (*  dec     ebx                            *)
    039H, 0D1H,              (*  cmp     ecx, edx                       *)
    074H, 006H,              (*  je      L2                             *)
    089H, 0C8H,              (*  mov     eax, ecx                       *)
    029H, 0D0H,              (*  sub     eax, edx                       *)
    0EBH, 006H,              (*  jmp     L3                             *)
                             (*  L2:                                    *)
    085H, 0C9H,              (*  test    ecx, ecx                       *)
    075H, 0E3H,              (*  jne     L1                             *)
    031H, 0C0H,              (*  xor     eax, eax                       *)
                             (*  L3:                                    *)
    05BH,                    (*  pop     ebx                            *)
    05FH,                    (*  pop     edi                            *)
    05EH,                    (*  pop     esi                            *)
    05DH,                    (*  pop     ebp                            *)
    0C2H, 00CH, 000H         (*  ret     12                             *)
    )
    RETURN 0
END strncmpw;
 
 
PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR
    res:  INTEGER;
    bRes: BOOLEAN;
    c:    CHAR;
 
BEGIN
 
    res := strncmp(str1, str2, MIN(len1, len2));
    IF res = minint THEN
        IF len1 > len2 THEN
            SYSTEM.GET(str1 + len2, c);
            res := ORD(c)
        ELSIF len1 < len2 THEN
            SYSTEM.GET(str2 + len1, c);
            res := -ORD(c)
        ELSE
            res := 0
        END
    END;
 
    CASE op OF
    |0: bRes := res =  0
    |1: bRes := res #  0
    |2: bRes := res <  0
    |3: bRes := res <= 0
    |4: bRes := res >  0
    |5: bRes := res >= 0
    END
 
    RETURN bRes
END _strcmp;
 
 
PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
VAR
    res:  INTEGER;
    bRes: BOOLEAN;
    c:    WCHAR;
 
BEGIN
 
    res := strncmpw(str1, str2, MIN(len1, len2));
    IF res = minint THEN
        IF len1 > len2 THEN
            SYSTEM.GET(str1 + len2 * 2, c);
            res := ORD(c)
        ELSIF len1 < len2 THEN
            SYSTEM.GET(str2 + len1 * 2, c);
            res := -ORD(c)
        ELSE
            res := 0
        END
    END;
 
    CASE op OF
    |0: bRes := res =  0
    |1: bRes := res #  0
    |2: bRes := res <  0
    |3: bRes := res <= 0
    |4: bRes := res >  0
    |5: bRes := res >= 0
    END
 
    RETURN bRes
END _strcmpw;
 
 
PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
VAR
    c: CHAR;
    i: INTEGER;
 
BEGIN
    i := 0;
    REPEAT
        SYSTEM.GET(pchar, c);
        s[i] := c;
        INC(pchar);
        INC(i)
    UNTIL c = 0X
END PCharToStr;
 
 
PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
VAR
    i, a, b: INTEGER;
    c: CHAR;
 
BEGIN
 
    i := 0;
    REPEAT
        str[i] := CHR(x MOD 10 + ORD("0"));
        x := x DIV 10;
        INC(i)
    UNTIL x = 0;
 
    a := 0;
    b := i - 1;
    WHILE a < b DO
        c := str[a];
        str[a] := str[b];
        str[b] := c;
        INC(a);
        DEC(b)
    END;
    str[i] := 0X
END IntToStr;
 
 
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
VAR
    n1, n2, i, j: INTEGER;
 
BEGIN
    n1 := LENGTH(s1);
    n2 := LENGTH(s2);
 
    ASSERT(n1 + n2 < LEN(s1));
 
    i := 0;
    j := n1;
    WHILE i < n2 DO
        s1[j] := s2[i];
        INC(i);
        INC(j)
    END;
 
    s1[j] := 0X
 
END append;
 
 
PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
VAR
    s, temp: ARRAY 1024 OF CHAR;
 
BEGIN
 
 
    CASE err OF
    | 1: s := "assertion failure"
    | 2: s := "NIL dereference"
    | 3: s := "bad divisor"
    | 4: s := "NIL procedure call"
    | 5: s := "type guard error"
    | 6: s := "index out of range"
    | 7: s := "invalid CASE"
    | 8: s := "array assignment error"
    | 9: s := "CHR out of range"
    |10: s := "WCHR out of range"
    |11: s := "BYTE out of range"
    END;
 
    append(s, API.eol);
 
    append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
    append(s, "line: ");   IntToStr(line, temp);     append(s, temp);
 
    API.DebugMsg(SYSTEM.ADR(s[0]), name);
 
    API.exit_thread(0)
END _error;
 
 
PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
BEGIN
    SYSTEM.GET(t0 + t1 + types, t0)
    RETURN t0 MOD 2
END _isrec;
 
 
PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
BEGIN
    IF p # 0 THEN
        SYSTEM.GET(p - WORD, p);
        SYSTEM.GET(t0 + p + types, p)
    END
 
    RETURN p MOD 2
END _is;
 
 
PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
BEGIN
    SYSTEM.GET(t0 + t1 + types, t0)
    RETURN t0 MOD 2
END _guardrec;
 
 
PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
BEGIN
    SYSTEM.GET(p, p);
    IF p # 0 THEN
        SYSTEM.GET(p - WORD, p);
        SYSTEM.GET(t0 + p + types, p)
    ELSE
        p := 1
    END
 
    RETURN p MOD 2
END _guard;
 
 
PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
 
    RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
END _dllentry;
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
PROCEDURE [stdcall] _sofinit*;
BEGIN
    API.sofinit
END _sofinit;
 
 
PROCEDURE [stdcall] _exit* (code: INTEGER);
BEGIN
    API.exit(code)
END _exit;
 
 
PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
VAR
    t0, t1, i, j: INTEGER;
 
BEGIN
    SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
    API.init(param, code);
 
    types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
    ASSERT(types # 0);
    FOR i := 0 TO tcount - 1 DO
        FOR j := 0 TO tcount - 1 DO
            t0 := i; t1 := j;
 
            WHILE (t1 # 0) & (t1 # t0) DO
                SYSTEM.GET(_types + t1 * WORD, t1)
            END;
 
            SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
        END
    END;
 
 
 
 
 
 
 
 
 
 
 
 
 
    name := modname
END _init;
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
END RTL.

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

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 – Rev 7696 → 7983