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

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

Subversion Repositories Kolibri OS

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