WebSVN – Kolibri OS – Blame – /programs/develop/oberon07/lib/RVMxI/32/FPU.ob07

Rev	Author	Line No.	Line
8859	leency	1	(*
		2	BSD 2-Clause License
		3
		4	Copyright (c) 2020-2021, Anton Krotov
		5	All rights reserved.
		6	*)
		7
		8	MODULE FPU;
		9
		10
		11	CONST
		12
		13	INF = 07F800000H;
		14	NINF = 0FF800000H;
		15	NAN = 07FC00000H;
		16
		17
		18	PROCEDURE div2 (b, a: INTEGER): INTEGER;
		19	VAR
		20	n, e, r, s: INTEGER;
		21
		22	BEGIN
		23	s := ORD(BITS(a) / BITS(b) - {0..30});
		24	e := (a DIV 800000H) MOD 256 - (b DIV 800000H) MOD 256 + 127;
		25
		26	a := a MOD 800000H + 800000H;
		27	b := b MOD 800000H + 800000H;
		28
		29	n := 800000H;
		30	r := 0;
		31
		32	IF a < b THEN
		33	a := a * 2;
		34	DEC(e)
		35	END;
		36
		37	WHILE (a > 0) & (n > 0) DO
		38	IF a >= b THEN
		39	INC(r, n);
		40	DEC(a, b)
		41	END;
		42	a := a * 2;
		43	n := n DIV 2
		44	END;
		45
		46	IF e <= 0 THEN
		47	e := 0;
		48	r := 800000H;
		49	s := 0
		50	ELSIF e >= 255 THEN
		51	e := 255;
		52	r := 800000H
		53	END
		54
		55	RETURN (r - 800000H) + e * 800000H + s
		56	END div2;
		57
		58
		59	PROCEDURE mul2 (b, a: INTEGER): INTEGER;
		60	VAR
		61	e, r, s: INTEGER;
		62
		63	BEGIN
		64	s := ORD(BITS(a) / BITS(b) - {0..30});
		65	e := (a DIV 800000H) MOD 256 + (b DIV 800000H) MOD 256 - 127;
		66
		67	a := a MOD 800000H + 800000H;
		68	b := b MOD 800000H + 800000H;
		69
		70	r := a * (b MOD 256);
		71	b := b DIV 256;
		72	r := LSR(r, 8);
		73
		74	INC(r, a * (b MOD 256));
		75	b := b DIV 256;
		76	r := LSR(r, 8);
		77
		78	INC(r, a * (b MOD 256));
		79	r := LSR(r, 7);
		80
		81	IF r >= 1000000H THEN
		82	r := r DIV 2;
		83	INC(e)
		84	END;
		85
		86	IF e <= 0 THEN
		87	e := 0;
		88	r := 800000H;
		89	s := 0
		90	ELSIF e >= 255 THEN
		91	e := 255;
		92	r := 800000H
		93	END
		94
		95	RETURN (r - 800000H) + e * 800000H + s
		96	END mul2;
		97
		98
		99	PROCEDURE add2 (b, a: INTEGER): INTEGER;
		100	VAR
		101	t, e, d: INTEGER;
		102
		103	BEGIN
		104	e := (a DIV 800000H) MOD 256;
		105	t := (b DIV 800000H) MOD 256;
		106	d := e - t;
		107
		108	a := a MOD 800000H + 800000H;
		109	b := b MOD 800000H + 800000H;
		110
		111	IF d > 0 THEN
		112	IF d < 24 THEN
		113	b := LSR(b, d)
		114	ELSE
		115	b := 0
		116	END
		117	ELSIF d < 0 THEN
		118	IF d > -24 THEN
		119	a := LSR(a, -d)
		120	ELSE
		121	a := 0
		122	END;
		123	e := t
		124	END;
		125
		126	INC(a, b);
		127
		128	IF a >= 1000000H THEN
		129	a := a DIV 2;
		130	INC(e)
		131	END;
		132
		133	IF e >= 255 THEN
		134	e := 255;
		135	a := 800000H
		136	END
		137
		138	RETURN (a - 800000H) + e * 800000H
		139	END add2;
		140
		141
		142	PROCEDURE sub2 (b, a: INTEGER): INTEGER;
		143	VAR
		144	t, e, d, s: INTEGER;
		145
		146	BEGIN
		147	e := (a DIV 800000H) MOD 256;
		148	t := (b DIV 800000H) MOD 256;
		149
		150	a := a MOD 800000H + 800000H;
		151	b := b MOD 800000H + 800000H;
		152
		153	d := e - t;
		154
		155	IF (d > 0) OR (d = 0) & (a >= b) THEN
		156	s := 0
		157	ELSE
		158	e := t;
		159	d := -d;
		160	t := a;
		161	a := b;
		162	b := t;
		163	s := 80000000H
		164	END;
		165
		166	IF d > 0 THEN
		167	IF d < 24 THEN
		168	b := LSR(b, d)
		169	ELSE
		170	b := 0
		171	END
		172	END;
		173
		174	DEC(a, b);
		175
		176	IF a = 0 THEN
		177	e := 0;
		178	a := 800000H;
		179	s := 0
		180	ELSE
		181	WHILE a < 800000H DO
		182	a := a * 2;
		183	DEC(e)
		184	END
		185	END;
		186
		187	IF e <= 0 THEN
		188	e := 0;
		189	a := 800000H;
		190	s := 0
		191	END
		192
		193	RETURN (a - 800000H) + e * 800000H + s
		194	END sub2;
		195
		196
		197	PROCEDURE zero (VAR x: INTEGER);
		198	BEGIN
		199	IF LSR(LSL(x, 1), 24) = 0 THEN
		200	x := 0
		201	END
		202	END zero;
		203
		204
		205	PROCEDURE isNaN (a: INTEGER): BOOLEAN;
		206	RETURN (a > INF) OR (a < 0) & (a > NINF)
		207	END isNaN;
		208
		209
		210	PROCEDURE isInf (a: INTEGER): BOOLEAN;
		211	RETURN LSL(a, 1) = 0FF000000H
		212	END isInf;
		213
		214
		215	PROCEDURE isNormal (a, b: INTEGER): BOOLEAN;
		216	RETURN (LSR(LSL(a, 1), 24) # 255) & (LSR(LSL(a, 1), 24) # 0) &
		217	(LSR(LSL(b, 1), 24) # 255) & (LSR(LSL(b, 1), 24) # 0)
		218	END isNormal;
		219
		220
		221	PROCEDURE add* (b, a: INTEGER): INTEGER;
		222	VAR
		223	r: INTEGER;
		224
		225	BEGIN
		226	zero(a); zero(b);
		227
		228	IF isNormal(a, b) THEN
		229
		230	IF a > 0 THEN
		231	IF b > 0 THEN
		232	r := add2(b, a)
		233	ELSE
		234	r := sub2(b, a)
		235	END
		236	ELSE
		237	IF b > 0 THEN
		238	r := sub2(a, b)
		239	ELSE
		240	r := add2(b, a) + 80000000H
		241	END
		242	END
		243
		244	ELSIF isNaN(a) OR isNaN(b) THEN
		245	r := NAN
		246	ELSIF isInf(a) & isInf(b) THEN
		247	IF a = b THEN
		248	r := a
		249	ELSE
		250	r := NAN
		251	END
		252	ELSIF isInf(a) THEN
		253	r := a
		254	ELSIF isInf(b) THEN
		255	r := b
		256	ELSIF a = 0 THEN
		257	r := b
		258	ELSIF b = 0 THEN
		259	r := a
		260	END
		261
		262	RETURN r
		263	END add;
		264
		265
		266	PROCEDURE sub* (b, a: INTEGER): INTEGER;
		267	VAR
		268	r: INTEGER;
		269
		270	BEGIN
		271	zero(a); zero(b);
		272
		273	IF isNormal(a, b) THEN
		274
		275	IF a > 0 THEN
		276	IF b > 0 THEN
		277	r := sub2(b, a)
		278	ELSE
		279	r := add2(b, a)
		280	END
		281	ELSE
		282	IF b > 0 THEN
		283	r := add2(b, a) + 80000000H
		284	ELSE
		285	r := sub2(a, b)
		286	END
		287	END
		288
		289	ELSIF isNaN(a) OR isNaN(b) THEN
		290	r := NAN
		291	ELSIF isInf(a) & isInf(b) THEN
		292	IF a # b THEN
		293	r := a
		294	ELSE
		295	r := NAN
		296	END
		297	ELSIF isInf(a) THEN
		298	r := a
		299	ELSIF isInf(b) THEN
		300	r := INF + ORD(BITS(b) / {31} - {0..30})
		301	ELSIF (a = 0) & (b = 0) THEN
		302	r := 0
		303	ELSIF a = 0 THEN
		304	r := ORD(BITS(b) / {31})
		305	ELSIF b = 0 THEN
		306	r := a
		307	END
		308
		309	RETURN r
		310	END sub;
		311
		312
		313	PROCEDURE mul* (b, a: INTEGER): INTEGER;
		314	VAR
		315	r: INTEGER;
		316
		317	BEGIN
		318	zero(a); zero(b);
		319
		320	IF isNormal(a, b) THEN
		321	r := mul2(b, a)
		322	ELSIF isNaN(a) OR isNaN(b) OR (isInf(a) & (b = 0)) OR (isInf(b) & (a = 0)) THEN
		323	r := NAN
		324	ELSIF isInf(a) OR isInf(b) THEN
		325	r := INF + ORD(BITS(a) / BITS(b) - {0..30})
		326	ELSIF (a = 0) OR (b = 0) THEN
		327	r := 0
		328	END
		329
		330	RETURN r
		331	END mul;
		332
		333
		334	PROCEDURE _div* (b, a: INTEGER): INTEGER;
		335	VAR
		336	r: INTEGER;
		337
		338	BEGIN
		339	zero(a); zero(b);
		340
		341	IF isNormal(a, b) THEN
		342	r := div2(b, a)
		343	ELSIF isNaN(a) OR isNaN(b) OR isInf(a) & isInf(b) THEN
		344	r := NAN
		345	ELSIF isInf(a) THEN
		346	r := INF + ORD(BITS(a) / BITS(b) - {0..30})
		347	ELSIF isInf(b) THEN
		348	r := 0
		349	ELSIF a = 0 THEN
		350	IF b = 0 THEN
		351	r := NAN
		352	ELSE
		353	r := 0
		354	END
		355	ELSIF b = 0 THEN
		356	IF a > 0 THEN
		357	r := INF
		358	ELSE
		359	r := NINF
		360	END
		361	END
		362
		363	RETURN r
		364	END _div;
		365
		366
		367	PROCEDURE cmp* (op, b, a: INTEGER): BOOLEAN;
		368	VAR
		369	res: BOOLEAN;
		370
		371	BEGIN
		372	zero(a); zero(b);
		373
		374	IF isNaN(a) OR isNaN(b) THEN
		375	res := op = 1
		376	ELSE
		377	IF (a < 0) & (b < 0) THEN
		378	INC(op, 6)
		379	END;
		380
		381	CASE op OF
		382	\|0, 6: res := a = b
		383	\|1, 7: res := a # b
		384	\|2, 10: res := a < b
		385	\|3, 11: res := a <= b
		386	\|4, 8: res := a > b
		387	\|5, 9: res := a >= b
		388	END
		389	END
		390
		391	RETURN res
		392	END cmp;
		393
		394
		395	PROCEDURE flt* (x: INTEGER): INTEGER;
		396	VAR
		397	n, y, s: INTEGER;
		398
		399	BEGIN
		400	IF x = 0 THEN
		401	s := 0;
		402	x := 800000H;
		403	n := -126
		404	ELSIF x = 80000000H THEN
		405	s := 80000000H;
		406	x := 800000H;
		407	n := 32
		408	ELSE
		409	IF x < 0 THEN
		410	s := 80000000H;
		411	x := -x
		412	ELSE
		413	s := 0
		414	END;
		415	n := 0;
		416	y := x;
		417	WHILE y > 0 DO
		418	y := y DIV 2;
		419	INC(n)
		420	END;
		421	IF n > 24 THEN
		422	x := LSR(x, n - 24)
		423	ELSE
		424	x := LSL(x, 24 - n)
		425	END
		426	END
		427
		428	RETURN (x - 800000H) + (n + 126) * 800000H + s
		429	END flt;
		430
		431
		432	PROCEDURE floor* (x: INTEGER): INTEGER;
		433	VAR
		434	r, e: INTEGER;
		435
		436	BEGIN
		437	zero(x);
		438
		439	e := (x DIV 800000H) MOD 256 - 127;
		440	r := x MOD 800000H + 800000H;
		441
		442	IF (0 <= e) & (e <= 22) THEN
		443	r := LSR(r, 23 - e) + ORD((x < 0) & (LSL(r, e + 9) # 0))
		444	ELSIF (23 <= e) & (e <= 54) THEN
		445	r := LSL(r, e - 23)
		446	ELSIF (e < 0) & (x < 0) THEN
		447	r := 1
		448	ELSE
		449	r := 0
		450	END;
		451
		452	IF x < 0 THEN
		453	r := -r
		454	END
		455
		456	RETURN r
		457	END floor;
		458
		459
		460	END FPU.

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/lib/RVMxI/32/FPU.ob07 – Rev 8859