WebSVN – Kolibri OS – Blame – /programs/develop/oberon07/Lib/Linux32/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
8097	maxcodehac	375	i, a: INTEGER;
7597	akron1	376
6613	leency	377	BEGIN
7597	akron1	378	i := 0;
8097	maxcodehac	379	a := x;
7597	akron1	380	REPEAT
8097	maxcodehac	381	INC(i);
		382	a := a DIV 10
		383	UNTIL a = 0;
		384
		385	str[i] := 0X;
		386
		387	REPEAT
		388	DEC(i);
7597	akron1	389	str[i] := CHR(x MOD 10 + ORD("0"));
8097	maxcodehac	390	x := x DIV 10
		391	UNTIL x = 0
7597	akron1	392	END IntToStr;
		393
		394
		395	PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
		396	VAR
8097	maxcodehac	397	n1, n2: INTEGER;
7983	leency	398
7597	akron1	399	BEGIN
		400	n1 := LENGTH(s1);
		401	n2 := LENGTH(s2);
		402
		403	ASSERT(n1 + n2 < LEN(s1));
		404
8097	maxcodehac	405	SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
		406	s1[n1 + n2] := 0X
7597	akron1	407	END append;
		408
		409
8097	maxcodehac	410	PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER);
7597	akron1	411	VAR
		412	s, temp: ARRAY 1024 OF CHAR;
		413
		414	BEGIN
7693	akron1	415	CASE err OF
7983	leency	416	\| 1: s := "assertion failure"
		417	\| 2: s := "NIL dereference"
		418	\| 3: s := "bad divisor"
		419	\| 4: s := "NIL procedure call"
		420	\| 5: s := "type guard error"
		421	\| 6: s := "index out of range"
		422	\| 7: s := "invalid CASE"
		423	\| 8: s := "array assignment error"
		424	\| 9: s := "CHR out of range"
		425	\|10: s := "WCHR out of range"
		426	\|11: s := "BYTE out of range"
7597	akron1	427	END;
		428
8097	maxcodehac	429	append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
		430	append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
7597	akron1	431
		432	API.DebugMsg(SYSTEM.ADR(s[0]), name);
		433
		434	API.exit_thread(0)
		435	END _error;
		436
		437
7693	akron1	438	PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
7597	akron1	439	BEGIN
7693	akron1	440	SYSTEM.GET(t0 + t1 + types, t0)
		441	RETURN t0 MOD 2
7597	akron1	442	END _isrec;
		443
		444
7693	akron1	445	PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
6613	leency	446	BEGIN
7597	akron1	447	IF p # 0 THEN
7696	akron1	448	SYSTEM.GET(p - WORD, p);
7693	akron1	449	SYSTEM.GET(t0 + p + types, p)
7597	akron1	450	END
		451
7693	akron1	452	RETURN p MOD 2
7597	akron1	453	END _is;
		454
		455
7693	akron1	456	PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
6613	leency	457	BEGIN
7693	akron1	458	SYSTEM.GET(t0 + t1 + types, t0)
		459	RETURN t0 MOD 2
7597	akron1	460	END _guardrec;
		461
		462
7693	akron1	463	PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
6613	leency	464	BEGIN
7597	akron1	465	SYSTEM.GET(p, p);
		466	IF p # 0 THEN
7696	akron1	467	SYSTEM.GET(p - WORD, p);
7693	akron1	468	SYSTEM.GET(t0 + p + types, p)
7597	akron1	469	ELSE
7693	akron1	470	p := 1
7597	akron1	471	END
6613	leency	472
7693	akron1	473	RETURN p MOD 2
7597	akron1	474	END _guard;
		475
		476
		477	PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
7983	leency	478	RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
		479	END _dllentry;
7597	akron1	480
7983	leency	481
		482	PROCEDURE [stdcall] _sofinit*;
6613	leency	483	BEGIN
7983	leency	484	API.sofinit
		485	END _sofinit;
6613	leency	486
7597	akron1	487
		488	PROCEDURE [stdcall] _exit* (code: INTEGER);
		489	BEGIN
		490	API.exit(code)
		491	END _exit;
		492
		493
7693	akron1	494	PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
		495	VAR
		496	t0, t1, i, j: INTEGER;
		497
7597	akron1	498	BEGIN
		499	SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
		500	API.init(param, code);
		501
7693	akron1	502	types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
		503	ASSERT(types # 0);
		504	FOR i := 0 TO tcount - 1 DO
		505	FOR j := 0 TO tcount - 1 DO
		506	t0 := i; t1 := j;
		507
		508	WHILE (t1 # 0) & (t1 # t0) DO
7696	akron1	509	SYSTEM.GET(_types + t1 * WORD, t1)
7693	akron1	510	END;
		511
		512	SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
		513	END
		514	END;
		515
7983	leency	516	name := modname
7597	akron1	517	END _init;
		518
		519
7983	leency	520	END RTL.

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Lib/Linux32/RTL.ob07 – Rev 8097