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

     DLL_THREAD_ATTACH   = 2;
     DLL_THREAD_DETACH   = 3;
     DLL_PROCESS_DETACH  = 0;
+    SIZE_OF_DWORD = 4;
-    SIZE_OF_DWORD = 4;
+    MAX_SET = 31;
 TYPE
 TYPE
         process_detach,
         thread_detach,
         thread_attach: DLL_ENTRY
     END;
+    fini: PROC;
 PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER);
     RETURN res
 END _arrcpy;
-PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER);
+PROCEDURE [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
-BEGIN
-    _move(MIN(len_dst, len_src) * chr_size, src, dst)
-END _strcpy;
-PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER);
 BEGIN
     _move(MIN(len_dst, len_src) * chr_size, src, dst)
-END _strcpy2;
+END _strcpy;
     A[k] := n
 END _rot;
-PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER;
 VAR
-    res: INTEGER;
+PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER;
 BEGIN
-    IF (a <= b) & (a <= 31) & (b >= 0) THEN
+    IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN
-        IF b > 31 THEN
+        IF b > MAX_SET THEN
-            b := 31
+            b := MAX_SET
         END;
         IF a < 0 THEN
             a := 0
         END;
-        res := LSR(ASR(ROR(1, 1), b - a), 31 - b)
+        a := LSR(ASR(ROR(1, 1), b - a), MAX_SET - b)
     ELSE
-        res := 0
+        a := 0
     END
-    RETURN res
+    RETURN a
-END _set2;
+END _set;
     RETURN 0
 END divmod;
-PROCEDURE div_ (x, y: INTEGER): INTEGER;
+PROCEDURE [stdcall] _div2* (x, y: INTEGER): INTEGER;
 VAR
     div, mod: INTEGER;
 BEGIN
     div := divmod(x, y, mod);
     IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN
         DEC(div)
     END
     RETURN div
-END div_;
+END _div2;
-PROCEDURE mod_ (x, y: INTEGER): INTEGER;
+PROCEDURE [stdcall] _mod2* (x, y: INTEGER): INTEGER;
 VAR
     div, mod: INTEGER;
 BEGIN
     div := divmod(x, y, mod);
-    IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN
-        INC(mod, y)
-    END
-    RETURN mod
-END mod_;
+    IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN
+        INC(mod, y)
     END
-PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER;
-    RETURN div_(a, b)
-END _div;
 PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER;
-    RETURN div_(a, b)
+    RETURN mod
-END _div2;
+END _mod2;
         ptr := API._DISPOSE(ptr - SIZE_OF_DWORD)
     END
 END _dispose;
-PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
-VAR
-    A, B: CHAR;
-    res:  INTEGER;
-BEGIN
-    res := 0;
-    WHILE n > 0 DO
-        SYSTEM.GET(a, A); INC(a);
-        SYSTEM.GET(b, B); INC(b);
-        DEC(n);
-        IF A # B THEN
-            res := ORD(A) - ORD(B);
-            n := 0
-        ELSIF A = 0X THEN
-            n := 0
-        END
-    END
-    RETURN res
-END strncmp;
-PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
-VAR
-    A, B: WCHAR;
-    res:  INTEGER;
-BEGIN
-    res := 0;
-    WHILE n > 0 DO
-        SYSTEM.GET(a, A); INC(a, 2);
-        SYSTEM.GET(b, B); INC(b, 2);
-        DEC(n);
-        IF A # B THEN
-            res := ORD(A) - ORD(B);
-            n := 0
-        ELSIF A = 0X THEN
-            n := 0
-        END
-    END
-    RETURN res
-END strncmpw;
 PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER;
 BEGIN
     RETURN 0
+END _lengthw;
+PROCEDURE strncmp (a, b, n: INTEGER): INTEGER;
+VAR
+    A, B: CHAR;
+    res: INTEGER;
+BEGIN
+    res := minint;
+    WHILE n > 0 DO
+        SYSTEM.GET(a, A); INC(a);
+        SYSTEM.GET(b, B); INC(b);
+        DEC(n);
+        IF A # B THEN
+            res := ORD(A) - ORD(B);
+            n := 0
+        ELSIF A = 0X THEN
+            res := 0;
+            n := 0
+        END
+    END
+    RETURN res
+END strncmp;
+PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER;
+VAR
+    A, B: WCHAR;
+    res: INTEGER;
+BEGIN
+    res := minint;
+    WHILE n > 0 DO
+        SYSTEM.GET(a, A); INC(a, 2);
+        SYSTEM.GET(b, B); INC(b, 2);
+        DEC(n);
+        IF A # B THEN
+            res := ORD(A) - ORD(B);
+            n := 0
+        ELSIF A = 0X THEN
+            res := 0;
+            n := 0
+        END
+    END
+    RETURN res
-END _lengthw;
+END strncmpw;
 PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
+VAR
-VAR
+    res:  INTEGER;
-    res:  INTEGER;
+    bRes: BOOLEAN;
-    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
-BEGIN
+            SYSTEM.GET(str2 + len1, c);
             res := -ORD(c)
-    res := strncmp(str1, str2, MIN(len1, len2));
+        ELSE
-    IF res = 0 THEN
+            res := 0
     RETURN bRes
-END _strcmp;
-PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
-    RETURN _strcmp(op, len2, str2, len1, str1)
-END _strcmp2;
+END _strcmp;
 PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
+VAR
-VAR
+    res:  INTEGER;
-    res:  INTEGER;
+    bRes: BOOLEAN;
-    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
-BEGIN
+            SYSTEM.GET(str2 + len1 * 2, c);
             res := -ORD(c)
-    res := strncmpw(str1, str2, MIN(len1, len2));
+        ELSE
-    IF res = 0 THEN
+            res := 0
     RETURN bRes
-END _strcmpw;
-PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN;
-    RETURN _strcmpw(op, len2, str2, len1, str1)
-END _strcmpw2;
+END _strcmpw;
 PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
     s1[j] := 0X
 END append;
-PROCEDURE [stdcall] _error* (module, err: INTEGER);
+PROCEDURE [stdcall] _error* (module, err, line: INTEGER);
 VAR
     s, temp: ARRAY 1024 OF CHAR;
 BEGIN
     s := "";
-    CASE err MOD 16 OF
+    CASE err OF
     END;
     append(s, API.eol);
-    append(s, "module: ");   PCharToStr(module, temp);     append(s, temp); append(s, API.eol);
+    append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol);
-    append(s, "line: ");     IntToStr(LSR(err, 4), temp);  append(s, temp);
+    append(s, "line: ");   IntToStr(line, temp);     append(s, temp);
     API.DebugMsg(SYSTEM.ADR(s[0]), name);
-    API.exit_thread(0)
-END _error;
+    API.exit_thread(0)
-PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN;
-BEGIN
-    (* r IS t0 *)
+END _error;
-    WHILE (t1 # 0) & (t1 # t0) DO
-        SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
-    END
-    RETURN t1 = t0
+PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
-END _isrec;
 BEGIN
-PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN;
+    SYSTEM.GET(t0 + t1 + types, t0)
-VAR
+    RETURN t0 MOD 2
-    t1: INTEGER;
-BEGIN
-    (* p IS t0 *)
-    IF p # 0 THEN
+END _isrec;
-        DEC(p, SIZE_OF_DWORD);
         SYSTEM.GET(p, t1);
-        WHILE (t1 # 0) & (t1 # t0) DO
+PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
-            SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
+BEGIN
-        END
-    ELSE
-        t1 := -1
-    END
+    IF p # 0 THEN
-    RETURN t1 = t0
-END _is;
+        SYSTEM.GET(p - SIZE_OF_DWORD, p);
         SYSTEM.GET(t0 + p + types, p)
+    END
-PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN;
-BEGIN
-    (* r:t1 IS t0 *)
-    WHILE (t1 # 0) & (t1 # t0) DO
-        SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1)
+    RETURN p MOD 2
-    END
+END _is;
-    RETURN t1 = t0
-END _guardrec;
-PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN;
+PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
-VAR
+BEGIN
-    t1:  INTEGER;
+    SYSTEM.GET(t0 + t1 + types, t0)
+    RETURN t0 MOD 2
-BEGIN
+END _guardrec;
     (* p IS t0 *)
     SYSTEM.GET(p, p);
 BEGIN
     API.exit(code)
 END _exit;
+PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
+VAR
     t0, t1, i, j: INTEGER;
 PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: 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;
-    SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
+            WHILE (t1 # 0) & (t1 # t0) DO
+                SYSTEM.GET(_types + t1 * SIZE_OF_DWORD, t1)
+            END;
+            SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
-    API.init(param, code);
+        END
     END;
     types := _types;
     name  := modname;
+    dll.process_detach := NIL;
     dll.thread_detach  := NIL;
+    dll.thread_attach  := NIL;
+    fini := NIL
+END _init;
+PROCEDURE [stdcall] _sofinit*;
+BEGIN
+    IF fini # NIL THEN
+        fini
+    END
+END _sofinit;
-    dll.process_detach := NIL;
+PROCEDURE SetFini* (ProcFini: PROC);
-    dll.thread_detach  := NIL;
+BEGIN

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 – Rev 7597 → 7693