Subversion Repositories Kolibri OS

Compare Revisions

Regard whitespace Rev 7982 → Rev 7983

/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07
1,7 → 1,7
(*
(*
BSD 2-Clause License
 
Copyright (c) 2018-2019, Anton Krotov
Copyright (c) 2018-2020, Anton Krotov
All rights reserved.
*)
 
16,36 → 16,16
maxint* = 7FFFFFFFH;
minint* = 80000000H;
 
DLL_PROCESS_ATTACH = 1;
DLL_THREAD_ATTACH = 2;
DLL_THREAD_DETACH = 3;
DLL_PROCESS_DETACH = 0;
 
WORD = bit_depth DIV 8;
MAX_SET = bit_depth - 1;
 
 
TYPE
 
DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER);
PROC = PROCEDURE;
 
 
VAR
 
name: INTEGER;
types: INTEGER;
bits: ARRAY MAX_SET + 1 OF INTEGER;
 
dll: RECORD
process_detach,
thread_detach,
thread_attach: DLL_ENTRY
END;
 
fini: PROC;
 
 
PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER);
BEGIN
SYSTEM.CODE(
97,7 → 77,6
i, n, k: INTEGER;
 
BEGIN
 
k := LEN(A) - 1;
n := A[0];
i := 0;
106,7 → 85,6
INC(i)
END;
A[k] := n
 
END _rot;
 
 
128,14 → 106,16
END _set;
 
 
PROCEDURE [stdcall] _set1* (a: INTEGER): INTEGER;
PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *)
BEGIN
IF ASR(a, 5) = 0 THEN
SYSTEM.GET(SYSTEM.ADR(bits[0]) + a * WORD, a)
ELSE
a := 0
END
RETURN a
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;
 
 
315,7 → 295,6
c: CHAR;
 
BEGIN
 
res := strncmp(str1, str2, MIN(len1, len2));
IF res = minint THEN
IF len1 > len2 THEN
349,7 → 328,6
c: WCHAR;
 
BEGIN
 
res := strncmpw(str1, str2, MIN(len1, len2));
IF res = minint THEN
IF len1 > len2 THEN
398,7 → 376,6
c: CHAR;
 
BEGIN
 
i := 0;
REPEAT
str[i] := CHR(x MOD 10 + ORD("0"));
422,6 → 399,7
PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
VAR
n1, n2, i, j: INTEGER;
 
BEGIN
n1 := LENGTH(s1);
n2 := LENGTH(s2);
437,7 → 415,6
END;
 
s1[j] := 0X
 
END append;
 
 
446,20 → 423,18
s, temp: ARRAY 1024 OF CHAR;
 
BEGIN
 
s := "";
CASE err OF
| 1: append(s, "assertion failure")
| 2: append(s, "NIL dereference")
| 3: append(s, "division by zero")
| 4: append(s, "NIL procedure call")
| 5: append(s, "type guard error")
| 6: append(s, "index out of range")
| 7: append(s, "invalid CASE")
| 8: append(s, "array assignment error")
| 9: append(s, "CHR out of range")
|10: append(s, "WCHR out of range")
|11: append(s, "BYTE out of range")
| 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);
513,36 → 488,16
 
 
PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
VAR
res: INTEGER;
RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
END _dllentry;
 
 
PROCEDURE [stdcall] _sofinit*;
BEGIN
CASE fdwReason OF
|DLL_PROCESS_ATTACH:
res := 1
|DLL_THREAD_ATTACH:
res := 0;
IF dll.thread_attach # NIL THEN
dll.thread_attach(hinstDLL, fdwReason, lpvReserved)
END
|DLL_THREAD_DETACH:
res := 0;
IF dll.thread_detach # NIL THEN
dll.thread_detach(hinstDLL, fdwReason, lpvReserved)
END
|DLL_PROCESS_DETACH:
res := 0;
IF dll.process_detach # NIL THEN
dll.process_detach(hinstDLL, fdwReason, lpvReserved)
END
ELSE
res := 0
END
API.sofinit
END _sofinit;
 
RETURN res
END _dllentry;
 
 
PROCEDURE [stdcall] _exit* (code: INTEGER);
BEGIN
API.exit(code)
571,42 → 526,8
END
END;
 
j := 1;
FOR i := 0 TO MAX_SET DO
bits[i] := j;
j := LSL(j, 1)
END;
 
name := modname;
 
dll.process_detach := NIL;
dll.thread_detach := NIL;
dll.thread_attach := NIL;
 
fini := NIL
name := modname
END _init;
 
 
PROCEDURE [stdcall] _sofinit*;
BEGIN
IF fini # NIL THEN
fini
END
END _sofinit;
 
 
PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY);
BEGIN
dll.process_detach := process_detach;
dll.thread_detach := thread_detach;
dll.thread_attach := thread_attach
END SetDll;
 
 
PROCEDURE SetFini* (ProcFini: PROC);
BEGIN
fini := ProcFini
END SetFini;
 
 
END RTL.
END RTL.