WebSVN – Kolibri OS – Blame – /drivers/examples/oberon_drv/RTL.ob07

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

Subversion Repositories Kolibri OS

(root)/drivers/examples/oberon_drv/RTL.ob07 – Rev 9849