Rev 7983 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
7983 | leency | 1 | (* |
8097 | maxcodehac | 2 | BSD 2-Clause License |
7983 | leency | 3 | |
8097 | maxcodehac | 4 | Copyright (c) 2013-2014, 2018-2020 Anton Krotov |
5 | All rights reserved. |
||
7983 | leency | 6 | *) |
7 | |||
8 | MODULE Math; |
||
9 | |||
10 | IMPORT SYSTEM; |
||
11 | |||
12 | |||
13 | CONST |
||
14 | |||
15 | pi* = 3.141592653589793; |
||
16 | e* = 2.718281828459045; |
||
17 | |||
18 | |||
19 | PROCEDURE IsNan* (x: REAL): BOOLEAN; |
||
20 | VAR |
||
21 | h, l: SET; |
||
22 | |||
23 | BEGIN |
||
24 | SYSTEM.GET(SYSTEM.ADR(x), l); |
||
25 | SYSTEM.GET(SYSTEM.ADR(x) + 4, h) |
||
26 | RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {})) |
||
27 | END IsNan; |
||
28 | |||
29 | |||
30 | PROCEDURE IsInf* (x: REAL): BOOLEAN; |
||
31 | RETURN ABS(x) = SYSTEM.INF() |
||
32 | END IsInf; |
||
33 | |||
34 | |||
35 | PROCEDURE Max (a, b: REAL): REAL; |
||
36 | VAR |
||
37 | res: REAL; |
||
38 | |||
39 | BEGIN |
||
40 | IF a > b THEN |
||
41 | res := a |
||
42 | ELSE |
||
43 | res := b |
||
44 | END |
||
45 | RETURN res |
||
46 | END Max; |
||
47 | |||
48 | |||
49 | PROCEDURE Min (a, b: REAL): REAL; |
||
50 | VAR |
||
51 | res: REAL; |
||
52 | |||
53 | BEGIN |
||
54 | IF a < b THEN |
||
55 | res := a |
||
56 | ELSE |
||
57 | res := b |
||
58 | END |
||
59 | RETURN res |
||
60 | END Min; |
||
61 | |||
62 | |||
63 | PROCEDURE SameValue (a, b: REAL): BOOLEAN; |
||
64 | VAR |
||
65 | eps: REAL; |
||
66 | res: BOOLEAN; |
||
67 | |||
68 | BEGIN |
||
69 | eps := Max(Min(ABS(a), ABS(b)) * 1.0E-12, 1.0E-12); |
||
70 | IF a > b THEN |
||
71 | res := (a - b) <= eps |
||
72 | ELSE |
||
73 | res := (b - a) <= eps |
||
74 | END |
||
75 | RETURN res |
||
76 | END SameValue; |
||
77 | |||
78 | |||
79 | PROCEDURE IsZero (x: REAL): BOOLEAN; |
||
80 | RETURN ABS(x) <= 1.0E-12 |
||
81 | END IsZero; |
||
82 | |||
83 | |||
84 | PROCEDURE [stdcall] sqrt* (x: REAL): REAL; |
||
85 | BEGIN |
||
86 | SYSTEM.CODE( |
||
87 | 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) |
||
88 | 0D9H, 0FAH, (* fsqrt *) |
||
89 | 0C9H, (* leave *) |
||
90 | 0C2H, 008H, 000H (* ret 08h *) |
||
91 | ) |
||
92 | RETURN 0.0 |
||
93 | END sqrt; |
||
94 | |||
95 | |||
96 | PROCEDURE [stdcall] sin* (x: REAL): REAL; |
||
97 | BEGIN |
||
98 | SYSTEM.CODE( |
||
99 | 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) |
||
100 | 0D9H, 0FEH, (* fsin *) |
||
101 | 0C9H, (* leave *) |
||
102 | 0C2H, 008H, 000H (* ret 08h *) |
||
103 | ) |
||
104 | RETURN 0.0 |
||
105 | END sin; |
||
106 | |||
107 | |||
108 | PROCEDURE [stdcall] cos* (x: REAL): REAL; |
||
109 | BEGIN |
||
110 | SYSTEM.CODE( |
||
111 | 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) |
||
112 | 0D9H, 0FFH, (* fcos *) |
||
113 | 0C9H, (* leave *) |
||
114 | 0C2H, 008H, 000H (* ret 08h *) |
||
115 | ) |
||
116 | RETURN 0.0 |
||
117 | END cos; |
||
118 | |||
119 | |||
120 | PROCEDURE [stdcall] tan* (x: REAL): REAL; |
||
121 | BEGIN |
||
122 | SYSTEM.CODE( |
||
123 | 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) |
||
124 | 0D9H, 0FBH, (* fsincos *) |
||
125 | 0DEH, 0F9H, (* fdivp st1, st *) |
||
126 | 0C9H, (* leave *) |
||
127 | 0C2H, 008H, 000H (* ret 08h *) |
||
128 | ) |
||
129 | RETURN 0.0 |
||
130 | END tan; |
||
131 | |||
132 | |||
133 | PROCEDURE [stdcall] arctan2* (y, x: REAL): REAL; |
||
134 | BEGIN |
||
135 | SYSTEM.CODE( |
||
136 | 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) |
||
137 | 0DDH, 045H, 010H, (* fld qword [ebp + 10h] *) |
||
138 | 0D9H, 0F3H, (* fpatan *) |
||
139 | 0C9H, (* leave *) |
||
140 | 0C2H, 010H, 000H (* ret 10h *) |
||
141 | ) |
||
142 | RETURN 0.0 |
||
143 | END arctan2; |
||
144 | |||
145 | |||
146 | PROCEDURE [stdcall] ln* (x: REAL): REAL; |
||
147 | BEGIN |
||
148 | SYSTEM.CODE( |
||
149 | 0D9H, 0EDH, (* fldln2 *) |
||
150 | 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) |
||
151 | 0D9H, 0F1H, (* fyl2x *) |
||
152 | 0C9H, (* leave *) |
||
153 | 0C2H, 008H, 000H (* ret 08h *) |
||
154 | ) |
||
155 | RETURN 0.0 |
||
156 | END ln; |
||
157 | |||
158 | |||
159 | PROCEDURE [stdcall] log* (base, x: REAL): REAL; |
||
160 | BEGIN |
||
161 | SYSTEM.CODE( |
||
162 | 0D9H, 0E8H, (* fld1 *) |
||
163 | 0DDH, 045H, 010H, (* fld qword [ebp + 10h] *) |
||
164 | 0D9H, 0F1H, (* fyl2x *) |
||
165 | 0D9H, 0E8H, (* fld1 *) |
||
166 | 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) |
||
167 | 0D9H, 0F1H, (* fyl2x *) |
||
168 | 0DEH, 0F9H, (* fdivp st1, st *) |
||
169 | 0C9H, (* leave *) |
||
170 | 0C2H, 010H, 000H (* ret 10h *) |
||
171 | ) |
||
172 | RETURN 0.0 |
||
173 | END log; |
||
174 | |||
175 | |||
176 | PROCEDURE [stdcall] exp* (x: REAL): REAL; |
||
177 | BEGIN |
||
178 | SYSTEM.CODE( |
||
179 | 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) |
||
180 | 0D9H, 0EAH, (* fldl2e *) |
||
181 | 0DEH, 0C9H, 0D9H, 0C0H, |
||
182 | 0D9H, 0FCH, 0DCH, 0E9H, |
||
183 | 0D9H, 0C9H, 0D9H, 0F0H, |
||
184 | 0D9H, 0E8H, 0DEH, 0C1H, |
||
185 | 0D9H, 0FDH, 0DDH, 0D9H, |
||
186 | 0C9H, (* leave *) |
||
187 | 0C2H, 008H, 000H (* ret 08h *) |
||
188 | ) |
||
189 | RETURN 0.0 |
||
190 | END exp; |
||
191 | |||
192 | |||
193 | PROCEDURE [stdcall] round* (x: REAL): REAL; |
||
194 | BEGIN |
||
195 | SYSTEM.CODE( |
||
196 | 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) |
||
197 | 0D9H, 07DH, 0F4H, 0D9H, |
||
198 | 07DH, 0F6H, 066H, 081H, |
||
199 | 04DH, 0F6H, 000H, 003H, |
||
200 | 0D9H, 06DH, 0F6H, 0D9H, |
||
201 | 0FCH, 0D9H, 06DH, 0F4H, |
||
202 | 0C9H, (* leave *) |
||
203 | 0C2H, 008H, 000H (* ret 08h *) |
||
204 | ) |
||
205 | RETURN 0.0 |
||
206 | END round; |
||
207 | |||
208 | |||
209 | PROCEDURE [stdcall] frac* (x: REAL): REAL; |
||
210 | BEGIN |
||
211 | SYSTEM.CODE( |
||
212 | 050H, |
||
213 | 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) |
||
214 | 0D9H, 0C0H, 0D9H, 03CH, |
||
215 | 024H, 0D9H, 07CH, 024H, |
||
216 | 002H, 066H, 081H, 04CH, |
||
217 | 024H, 002H, 000H, 00FH, |
||
218 | 0D9H, 06CH, 024H, 002H, |
||
219 | 0D9H, 0FCH, 0D9H, 02CH, |
||
220 | 024H, 0DEH, 0E9H, |
||
221 | 0C9H, (* leave *) |
||
222 | 0C2H, 008H, 000H (* ret 08h *) |
||
223 | ) |
||
224 | RETURN 0.0 |
||
225 | END frac; |
||
226 | |||
227 | |||
8097 | maxcodehac | 228 | PROCEDURE sqri* (x: INTEGER): INTEGER; |
229 | RETURN x * x |
||
230 | END sqri; |
||
231 | |||
232 | |||
233 | PROCEDURE sqrr* (x: REAL): REAL; |
||
234 | RETURN x * x |
||
235 | END sqrr; |
||
236 | |||
237 | |||
7983 | leency | 238 | PROCEDURE arcsin* (x: REAL): REAL; |
239 | RETURN arctan2(x, sqrt(1.0 - x * x)) |
||
240 | END arcsin; |
||
241 | |||
242 | |||
243 | PROCEDURE arccos* (x: REAL): REAL; |
||
244 | RETURN arctan2(sqrt(1.0 - x * x), x) |
||
245 | END arccos; |
||
246 | |||
247 | |||
248 | PROCEDURE arctan* (x: REAL): REAL; |
||
249 | RETURN arctan2(x, 1.0) |
||
250 | END arctan; |
||
251 | |||
252 | |||
253 | PROCEDURE sinh* (x: REAL): REAL; |
||
254 | BEGIN |
||
255 | x := exp(x) |
||
256 | RETURN (x - 1.0 / x) * 0.5 |
||
257 | END sinh; |
||
258 | |||
259 | |||
260 | PROCEDURE cosh* (x: REAL): REAL; |
||
261 | BEGIN |
||
262 | x := exp(x) |
||
263 | RETURN (x + 1.0 / x) * 0.5 |
||
264 | END cosh; |
||
265 | |||
266 | |||
267 | PROCEDURE tanh* (x: REAL): REAL; |
||
268 | BEGIN |
||
269 | IF x > 15.0 THEN |
||
270 | x := 1.0 |
||
271 | ELSIF x < -15.0 THEN |
||
272 | x := -1.0 |
||
273 | ELSE |
||
274 | x := exp(2.0 * x); |
||
275 | x := (x - 1.0) / (x + 1.0) |
||
276 | END |
||
277 | |||
278 | RETURN x |
||
279 | END tanh; |
||
280 | |||
281 | |||
282 | PROCEDURE arsinh* (x: REAL): REAL; |
||
283 | RETURN ln(x + sqrt(x * x + 1.0)) |
||
284 | END arsinh; |
||
285 | |||
286 | |||
287 | PROCEDURE arcosh* (x: REAL): REAL; |
||
288 | RETURN ln(x + sqrt(x * x - 1.0)) |
||
289 | END arcosh; |
||
290 | |||
291 | |||
292 | PROCEDURE artanh* (x: REAL): REAL; |
||
293 | VAR |
||
294 | res: REAL; |
||
295 | |||
296 | BEGIN |
||
297 | IF SameValue(x, 1.0) THEN |
||
298 | res := SYSTEM.INF() |
||
299 | ELSIF SameValue(x, -1.0) THEN |
||
300 | res := -SYSTEM.INF() |
||
301 | ELSE |
||
302 | res := 0.5 * ln((1.0 + x) / (1.0 - x)) |
||
303 | END |
||
304 | RETURN res |
||
305 | END artanh; |
||
306 | |||
307 | |||
308 | PROCEDURE floor* (x: REAL): REAL; |
||
309 | VAR |
||
310 | f: REAL; |
||
311 | |||
312 | BEGIN |
||
313 | f := frac(x); |
||
314 | x := x - f; |
||
315 | IF f < 0.0 THEN |
||
316 | x := x - 1.0 |
||
317 | END |
||
318 | RETURN x |
||
319 | END floor; |
||
320 | |||
321 | |||
322 | PROCEDURE ceil* (x: REAL): REAL; |
||
323 | VAR |
||
324 | f: REAL; |
||
325 | |||
326 | BEGIN |
||
327 | f := frac(x); |
||
328 | x := x - f; |
||
329 | IF f > 0.0 THEN |
||
330 | x := x + 1.0 |
||
331 | END |
||
332 | RETURN x |
||
333 | END ceil; |
||
334 | |||
335 | |||
336 | PROCEDURE power* (base, exponent: REAL): REAL; |
||
337 | VAR |
||
338 | res: REAL; |
||
339 | |||
340 | BEGIN |
||
341 | IF exponent = 0.0 THEN |
||
342 | res := 1.0 |
||
343 | ELSIF (base = 0.0) & (exponent > 0.0) THEN |
||
344 | res := 0.0 |
||
345 | ELSE |
||
346 | res := exp(exponent * ln(base)) |
||
347 | END |
||
348 | RETURN res |
||
349 | END power; |
||
350 | |||
351 | |||
8097 | maxcodehac | 352 | PROCEDURE ipower* (base: REAL; exponent: INTEGER): REAL; |
353 | VAR |
||
354 | i: INTEGER; |
||
355 | a: REAL; |
||
356 | |||
357 | BEGIN |
||
358 | a := 1.0; |
||
359 | |||
360 | IF base # 0.0 THEN |
||
361 | IF exponent # 0 THEN |
||
362 | IF exponent < 0 THEN |
||
363 | base := 1.0 / base |
||
364 | END; |
||
365 | i := ABS(exponent); |
||
366 | WHILE i > 0 DO |
||
367 | WHILE ~ODD(i) DO |
||
368 | i := LSR(i, 1); |
||
369 | base := sqrr(base) |
||
370 | END; |
||
371 | DEC(i); |
||
372 | a := a * base |
||
373 | END |
||
374 | ELSE |
||
375 | a := 1.0 |
||
376 | END |
||
377 | ELSE |
||
378 | ASSERT(exponent > 0); |
||
379 | a := 0.0 |
||
380 | END |
||
381 | |||
382 | RETURN a |
||
383 | END ipower; |
||
384 | |||
385 | |||
7983 | leency | 386 | PROCEDURE sgn* (x: REAL): INTEGER; |
387 | VAR |
||
388 | res: INTEGER; |
||
389 | |||
390 | BEGIN |
||
391 | IF x > 0.0 THEN |
||
392 | res := 1 |
||
393 | ELSIF x < 0.0 THEN |
||
394 | res := -1 |
||
395 | ELSE |
||
396 | res := 0 |
||
397 | END |
||
398 | |||
399 | RETURN res |
||
400 | END sgn; |
||
401 | |||
402 | |||
403 | PROCEDURE fact* (n: INTEGER): REAL; |
||
404 | VAR |
||
405 | res: REAL; |
||
406 | |||
407 | BEGIN |
||
408 | res := 1.0; |
||
409 | WHILE n > 1 DO |
||
410 | res := res * FLT(n); |
||
411 | DEC(n) |
||
412 | END |
||
413 | |||
414 | RETURN res |
||
415 | END fact; |
||
416 | |||
417 | |||
8097 | maxcodehac | 418 | PROCEDURE DegToRad* (x: REAL): REAL; |
419 | RETURN x * (pi / 180.0) |
||
420 | END DegToRad; |
||
421 | |||
422 | |||
423 | PROCEDURE RadToDeg* (x: REAL): REAL; |
||
424 | RETURN x * (180.0 / pi) |
||
425 | END RadToDeg; |
||
426 | |||
427 | |||
428 | (* Return hypotenuse of triangle *) |
||
429 | PROCEDURE hypot* (x, y: REAL): REAL; |
||
430 | VAR |
||
431 | a: REAL; |
||
432 | |||
433 | BEGIN |
||
434 | x := ABS(x); |
||
435 | y := ABS(y); |
||
436 | IF x > y THEN |
||
437 | a := x * sqrt(1.0 + sqrr(y / x)) |
||
438 | ELSE |
||
439 | IF x > 0.0 THEN |
||
440 | a := y * sqrt(1.0 + sqrr(x / y)) |
||
441 | ELSE |
||
442 | a := y |
||
443 | END |
||
444 | END |
||
445 | |||
446 | RETURN a |
||
447 | END hypot; |
||
448 | |||
449 | |||
7983 | leency | 450 | END Math.>>>>=>=>=>> |