← Back to branch summary

~ubuntu-branches/ubuntu/utopic/mricron/utopic

« back to all changes in this revision

Viewing changes to npm/dmath/mathp2.inc

  • Committer: Bazaar Package Importer
  • Author(s): Michael Hanke
  • Date: 2010-07-29 22:07:43 UTC
  • Revision ID: james.westby@ubuntu.com-20100729220743-q621ts2zj806gu0n
Tags: upstream-0.20100725.1~dfsg.1
Import upstream version 0.20100725.1~dfsg.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
npm/dmath/mathp2.inc
 
1
{ **********************************************************************
 
2
  *                             MATHP2.INC                             *
 
3
  **********************************************************************
 
4
                    Mathematical functions for TPMATH
 
5
             (Assembler version for Pentium II/III with FPC)
 
6
  ********************************************************************** }
 
7
 
 
8
 
 
9
{ Bibliotheque mathematique pour utilisation du coprocesseur flottant
 
10
  JD GAYRARD Sept. 95
 
11
 
 
12
  ----------------------------------------------------------------------
 
13
  Unite d'origine : MATH387.PAS, disponible dans MATHLIB2.ZIP
 
14
  (http://wcarchive.cdrom.com/pub/delphi_www/)
 
15
  Adapte aux pentiums II/III et complete par P. NOGARET (2000)
 
16
  ---------------------------------------------------------------------- }
 
17
 
 
18
 
 
19
 
 
20
{***********************************************************************}
 
21
{*              function fexp(x : Float): Float;assembler;             *}
 
22
{***********************************************************************}
 
23
{*   Fonction d�velopp�e � partir du document de Agner Fog             *}
 
24
{*   www.agner.org/assem                                               *}
 
25
{***********************************************************************}
 
26
{*   retourne e^x, par la methode e^x = 2^(x.log2(e))                  *}
 
27
{*   2^z = 2^f.2^i avec f = frac(z) and i = int(z)                     *}
 
28
{*   2^f is computed with F2XM1,                                       *}
 
29
{*   2^i pourrait �tre calcul� avec FSCALE mais cette instruction      *}
 
30
{*   est tr�s lente 56 micro-ops sur un pentium II                     *}
 
31
{*   pour la m�thode utilis� pour calculer 2^i voir Agner Fog          *}
 
32
{***********************************************************************}
 
33
{*                  st(0)                      st(1)                   *}
 
34
{*                 log2(e)                       -                     *}
 
35
{*                   x                        log2(e)                  *}
 
36
{*                 z:=x.log2(e)                  -                     *}
 
37
{*                   z                           -                     *}
 
38
{*                z - round(z)                   -                     *}
 
39
{*             2^(z - round(z)) - 1              -                     *}
 
40
{*                   1                  2^(z - round(z)) - 1           *}
 
41
{*             2^(z - round(z))                  -                     *}
 
42
{*               temp:=2^i              2^f:=2^(z - round(z))          *}
 
43
{*                  e^x                          -                     *}
 
44
{***********************************************************************}
 
45
  function fexp(x : Float): Float;assembler;
 
46
  var
 
47
    round_z : dword;
 
48
    temp    : extended;
 
49
  asm                       
 
50
    FLDL2E
 
51
    FLD x                              
 
52
    FMULP
 
53
    FIST round_z                       
 
54
    MOV DWORD PTR [temp],  00000000H   
 
55
    MOV DWORD PTR [temp+4],80000000H   
 
56
    FISUB round_z
 
57
    MOV EAX, round_z                  
 
58
    ADD EAX, 00003FFFH
 
59
    MOV DWORD PTR [temp+8],EAX        
 
60
    F2XM1                              
 
61
    FLD1
 
62
    FADDP                              
 
63
    FLD TBYTE PTR [temp]               
 
64
    FMULP                              
 
65
  end ['eax'];
 
66
 
 
67
 
 
68
{***********************************************************************}
 
69
{*            function fexp2(x : Float): Float; assembler;             *}
 
70
{***********************************************************************}
 
71
{*   Fonction d�velopp�e � partir du document de Agner Fog             *}
 
72
{*   www.agner.org/assem                                               *}
 
73
{***********************************************************************}
 
74
{*   retourne 2^x par la methode 2^z = 2^f.2^i                         *}
 
75
{*   avec f = frac(z) and i = int(z)                                   *}
 
76
{*   2^f is computed with F2XM1,                                       *}
 
77
{*   2^i pourrait �tre calcul� avec FSCALE mais cette instruction      *}
 
78
{*   est tr�s lente 56 micro-ops sur un pentium II                     *}
 
79
{*   pour la m�thode utilis� pour calculer 2^i voir Agner Fog          *}
 
80
{***********************************************************************}
 
81
{*                  st(0)                      st(1)                   *}
 
82
{*                   x                           -                     *}
 
83
{*                  z:=x                         -                     *}
 
84
{*                   z                           -                     *}
 
85
{*                z - round(z)                   -                     *}
 
86
{*             2^(z - round(z)) - 1              -                     *}
 
87
{*                   1                  2^(z - round(z)) - 1           *}
 
88
{*             2^(z - round(z))                  -                     *}
 
89
{*               temp:=2^i              2^f:=2^(z - round(z))          *}
 
90
{*                  e^x                          -                     *}
 
91
{***********************************************************************}
 
92
  function fexp2(x : Float): Float; assembler;
 
93
  var
 
94
    round_z : dword;
 
95
    temp    : extended;
 
96
  asm
 
97
    FLD x                   
 
98
    FIST round_z            
 
99
    MOV DWORD PTR [temp],  00000000H
 
100
    MOV DWORD PTR [temp+4],80000000H
 
101
    FISUB round_z           
 
102
    MOV EAX, round_z   { round_zmax := 16384 }
 
103
    ADD EAX, 00003FFFH
 
104
    MOV DWORD PTR [temp+8],EAX
 
105
    F2XM1                   
 
106
    FLD1                    
 
107
    FADDP                   
 
108
    FLD TBYTE PTR [temp]     
 
109
    FMULP                    
 
110
  end ['EAX'];
 
111
 
 
112
{***********************************************************************}
 
113
{*            function fexp10(x : Float): Float; assembler;            *}
 
114
{***********************************************************************}
 
115
{*   Fonction d�velopp�e � partir du document de Agner Fog             *}
 
116
{*   www.agner.org/assem                                               *}
 
117
{***********************************************************************}
 
118
{*   retourne 10^x, par la methode 10^x = 2^(x.log2(10))               *}
 
119
{*   2^z = 2^f.2^i with f = frac(z) and i = int(z)                     *}
 
120
{*   2^f is computed with F2XM1                                        *}
 
121
{*   2^i pourrait �tre calcul� avec FSCALE mais cette instruction      *}
 
122
{*   est tr�s lente 56 micro-ops sur un pentium II                     *}
 
123
{*   pour la m�thode utilis� pour calculer 2^i voir Agner Fog          *}
 
124
{***********************************************************************}
 
125
{*                  st(0)                      st(1)                   *}
 
126
{*                 log2(10)                      -                     *}
 
127
{*                   x                        log2(10)                 *}
 
128
{*                 z:=x.log2(10)                 -                     *}
 
129
{*                   z                           -                     *}
 
130
{*                z - round(z)                   -                     *}
 
131
{*             2^(z - round(z)) - 1              -                     *}
 
132
{*                   1                  2^(z - round(z)) - 1           *}
 
133
{*             2^(z - round(z))                  -                     *}
 
134
{*               temp:=2^i              2^f:=2^(z - round(z))          *}
 
135
{*                  10^x                         -                     *}
 
136
{***********************************************************************}
 
137
  function fexp10(x : Float): Float; assembler;
 
138
  var
 
139
    round_z : dword;
 
140
    temp    : extended;
 
141
  asm
 
142
   FLDL2T             
 
143
   FLD X              
 
144
   FMULP              
 
145
   FIST round_z            
 
146
   MOV DWORD PTR [temp],  00000000H
 
147
   MOV DWORD PTR [temp+4],80000000H
 
148
   FISUB round_z           
 
149
   MOV EAX, round_z   
 
150
   ADD EAX, 00003FFFH
 
151
   MOV DWORD PTR [temp+8],EAX
 
152
   F2XM1                   
 
153
   FLD1
 
154
   FADDP                   
 
155
   FLD TBYTE PTR [temp]     
 
156
   FMULP                   
 
157
  end ['EAX'];
 
158
 
 
159
function fln(x : Float): Float; assembler;
 
160
{ retourne le logarithme naturel de x, utilise
 
161
 la methode loge(x) = loge(2).log2(x) }
 
162
{ pas de verification du domaine de definition (x < 0) }
 
163
asm             {  ST(0)          ST(1)  }
 
164
   FLDLN2       { ln(2)            -     }
 
165
   FLD X        {   x             ln(2)  }
 
166
   FYL2X        { ln(2).log2(x)    -     }
 
167
end;
 
168
 
 
169
function flog2(x : Float): Float; assembler;
 
170
{ retourne le logarithme de base 2 de x }
 
171
{ pas de verification du domaine de definition (x < 0) }
 
172
asm             {  ST(0)          ST(1)  }
 
173
   FLD1         {   1               -    }
 
174
   FLD X        {   x               1    }
 
175
   FYL2X        { log2(x)           -    }
 
176
end;
 
177
 
 
178
{***********************************************************************}
 
179
{*                function flog10(X : Float) : Float;                  *}
 
180
{***********************************************************************}
 
181
{* Compute a common (base 10) logarithm. If X is near 1.0, then we     *}
 
182
{* use the FYL2XP1 instruction instead of FYL2X. "Near" means between  *}
 
183
{* 1.0 and 1+Sqrt(2)/2. We use an approximation for Sqrt(2)/2, so we   *}
 
184
{* don't have to compute it. The exact value isn't important, since    *}
 
185
{* FYL2X works fine for values near the transition.                    *}
 
186
{***********************************************************************}
 
187
  function flog10(x : Float): Float; assembler;
 
188
  const
 
189
    HalfSqrt2p1: Extended = 1.7071;
 
190
  asm
 
191
     fldlg2          { push Log2 }
 
192
     fld X           { push X }
 
193
     fld1            { push 1.0 }
 
194
     fcomp ST(1)     { if (X < 1.0) }
 
195
     jl @@1          {    goto @@1 }
 
196
     fld HalfSqrt2p1 { push 1.707 }
 
197
     fcomp ST(1)     { if (X > 1.707) }
 
198
     jg @@1          {    goto @@1 }
 
199
     fld1            { X is small, so subtract 1.0 }
 
200
     fsubrp          { X := X - 1.0 }
 
201
     fyl2xp1         { Log10(2) * Log2(X+1) }
 
202
     jmp @@2
 
203
   @@1:              { X is not near 1.0 }
 
204
     fyl2x           { Log10(2) * Log2(X) }
 
205
   @@2:
 
206
  end;
 
207
 
 
208
{***********************************************************************}
 
209
{*              function fsin(X : Float) : Float;                      *}
 
210
{***********************************************************************}
 
211
{*    if x < pi.2^62, then C2 is set to 0 and ST = sin(x)              *}
 
212
{*                       else C2 is set to 1 and ST = x                *}
 
213
{*    no check range validity is performed in this function            *}
 
214
{***********************************************************************}
 
215
  function fsin(X : Float) : Float; assembler;
 
216
  asm
 
217
    FLD x
 
218
    fsin
 
219
  end;
 
220
 
 
221
{***********************************************************************}
 
222
{*              function fcos(X : Float) : Float;                      *}
 
223
{***********************************************************************}
 
224
  function fcos(X : Float) : Float; assembler;
 
225
  asm
 
226
    FLD x
 
227
    fcos
 
228
  end;
 
229
 
 
230
{***********************************************************************}
 
231
{*              function ftan(X : Float) : Float;assembler;            *}
 
232
{***********************************************************************}
 
233
  function ftan(X : Float) : Float; assembler;
 
234
  asm             { ST(0)    ST(1) }
 
235
    FLD x         {  x        -    }
 
236
    FPTAN         {  1      tan(x) }
 
237
    FSTP ST(0)    { tan(x)    -    }
 
238
  end;
 
239
 
 
240
{***********************************************************************}
 
241
{*                function farctan(X : Float) : Float;                 *}
 
242
{***********************************************************************}
 
243
  function farctan(x : Float): Float; assembler;
 
244
  asm              { ST(0)    ST(1) }
 
245
     FLD x         {  x         -   }
 
246
     FLD1          {  1         x   }
 
247
     FPATAN        { atan(x/1)  -   }
 
248
  end;
 
249
 
 
250
{***********************************************************************}
 
251
{*             function farctan2(Y, X : Float) : Float;                *}
 
252
{***********************************************************************}
 
253
function farctan2(y, x : Float): Float; assembler;
 
254
{ retourne arctan (y / x) }
 
255
asm              { ST(0)    ST(1) }
 
256
   FLD y         {  y         -   }
 
257
   FLD x         {  x         y   }
 
258
   FPATAN        { atan(y/x)  -   }
 
259
end;
 
260
 
 
261
{***********************************************************************}
 
262
{*                function farcsin(X : Float) : Float;                 *}
 
263
{***********************************************************************}
 
264
{* retourne l'arcsin de x                                              *}
 
265
{*  methode :                ________                                  *}
 
266
{*  arcsin(x) = arctan( x / V 1 - x.x )                                *}
 
267
{*  no range validity check is performed in this function |x| > 1      *}
 
268
{***********************************************************************}
 
269
{*               ST(0)     ST(1)     ST(2)                             *}
 
270
{*                x         -         -                                *}
 
271
{*                x         x         -                                *}
 
272
{*               x.x        x         -                                *}
 
273
{*                1        x.x        x                                *}
 
274
{*              1 - x�      x         -                                *}
 
275
{*             sqrt(1-x�)   x         -                                *}
 
276
{*             arcsin(x)    -         -                                *}
 
277
{***********************************************************************}
 
278
function farcsin(x : Float): Float; assembler;
 
279
asm                 
 
280
   FLD X            
 
281
   FLD ST(0)        
 
282
   FMUL ST(0), ST   
 
283
   FLD1             
 
284
   FSUBRP ST(1), ST 
 
285
   FSQRT            
 
286
   FPATAN           
 
287
end;
 
288
 
 
289
{***********************************************************************}
 
290
{*            function farccos(x : Float): Float; assembler;           *}
 
291
{***********************************************************************}
 
292
{* retourne l'arccos de x                                              *}
 
293
{*  methode :            ________                                      *}
 
294
{*  arccos(x) = arctan( V 1 - x.x / x)                                 *}
 
295
{*  pas de controle de domaine de definition |x| > 1                   *}
 
296
{***********************************************************************}
 
297
{*               ST(0)     ST(1)     ST(2)                             *}
 
298
{*                x         -         -                                *}
 
299
{*                x         x         -                                *}
 
300
{*               x.x        x         -                                *}
 
301
{*                1        x.x        x                                *}
 
302
{*              1 - x�      x         -                                *}
 
303
{*             sqrt(1-x�)   x         -                                *}
 
304
{*                x         z         -                                *}
 
305
{*             arccos(x)    -         -                                *}
 
306
{***********************************************************************}
 
307
function farccos(x : Float): Float; assembler;
 
308
asm                 
 
309
   FLD X            
 
310
   FLD ST(0)        
 
311
   FMUL ST(0), ST   
 
312
   FLD1             
 
313
   FSUBRP ST(1), ST 
 
314
   FSQRT
 
315
   FXCH            
 
316
   FPATAN          
 
317
end;
 
318
 
 
319
{***********************************************************************}
 
320
{*            function fsinh(X : Float) : Float;                       *}
 
321
{***********************************************************************}
 
322
{*      retourne le sinus hyperbolique de l'argument                   *}
 
323
{*      sh(x) = [exp(x) - exp(-x)] / 2                                 *}
 
324
{*      methode : z = exp(x), ch(x) = 1/2 (z - 1/z)                    *}
 
325
{*          z = 2^y, y = x.log2(e),                                    *}
 
326
{*          z = 2^f.2^i, f = frac(y), i = int(y)                       *}
 
327
{*      2^f est calcul� avec F2XM1, 2^i sans FSCALE                    *}
 
328
{***********************************************************************}
 
329
{*            ST(0)                      ST(1)                 ST(2)   *}
 
330
{*           log2(e)                       -                     -     *}
 
331
{*             x                        log2(e)                  -     *}
 
332
{*           z:=x.log2(e)                  -                     -     *}
 
333
{*             z                           -                     -     *}
 
334
{*          z - round(z)                   -                     -     *}
 
335
{*       2^(z - round(z)) - 1              -                     -     *}
 
336
{*             1                  2^(z - round(z)) - 1           -     *}
 
337
{*       2^(z - round(z))                  -                     -     *}
 
338
{*         temp:=2^i              2^f:=2^(z - round(z))          -     *}
 
339
{*            e^x                          -                     -     *}
 
340
{*            e^x                         e^x                    -     *}
 
341
{*             1                           z                     z     *}
 
342
{*            1/z                          z                     -     *}
 
343
{*           z-1/z                         -                     -     *}
 
344
{*            0.5                        z-1/z                   -     *}
 
345
{*           sh(x)                         -                     -     *}
 
346
{***********************************************************************}
 
347
function fsinh(x : float): float; assembler;
 
348
const
 
349
  one_half : float = 0.5;
 
350
var
 
351
  round_z : dword;
 
352
  temp    : extended;
 
353
asm
 
354
  FLDL2E                  
 
355
  FLD x                   
 
356
  FMULP                   
 
357
  FIST round_z            
 
358
  MOV DWORD PTR [temp],  00000000H
 
359
  MOV DWORD PTR [temp+4],80000000H
 
360
  FISUB round_z           
 
361
  MOV EAX, round_z   
 
362
  ADD EAX, 00003FFFH
 
363
  MOV DWORD PTR [temp+8],EAX
 
364
  F2XM1                   
 
365
  FLD1                    
 
366
  FADDP                   
 
367
  FLD TBYTE PTR [temp]     
 
368
  FMULP                   
 
369
  FST ST(1)          
 
370
  FLD1               
 
371
  FDIVRP ST(1), ST   
 
372
  FSUBP ST(1), ST
 
373
  FLD one_half       
 
374
  FMULP ST(1), ST    
 
375
end;
 
376
 
 
377
{***********************************************************************}
 
378
{*                  function fcosh(X : Float) : Float;                 *}
 
379
{***********************************************************************}
 
380
{*      retourne le cosinus hyperbolique de l'argument                 *}
 
381
{*      ch(x) = [exp(x) + exp(-x)] / 2                                 *}
 
382
{*      methode : z = exp(x), ch(x) = 1/2 (z + 1/z)                    *}
 
383
{*          z = 2^y, y = x.log2(e),                                    *}
 
384
{*          z = 2^f.2^i, f = frac(y), i = int(y)                       *}
 
385
{*      2^f est calcul� avec F2XM1, 2^i sans FSCALE                    *}
 
386
{***********************************************************************}
 
387
{*         st(0)                      st(1)               st(2)        *}
 
388
{*        log2(e)                       -                              *}
 
389
{*          x                        log2(e)                           *}
 
390
{*        z:=x.log2(e)                  -                              *}
 
391
{*          z                           -                              *}
 
392
{*       z - round(z)                   -                              *}
 
393
{*    2^(z - round(z)) - 1              -                              *}
 
394
{*          1                  2^(z - round(z)) - 1                    *}
 
395
{*    2^(z - round(z))                  -                              *}
 
396
{*     temp:=2^i              2^f:=2^(z - round(z))                    *}
 
397
{*         e^x                          -                              *}
 
398
{*         e^x                         e^x                 -           *}
 
399
{*          1                           z                  z           *}
 
400
{*         1/z                          z                  -           *}
 
401
{*        z+1/z                         -                  -           *}
 
402
{*         0.5                        z+1/z                -           *}
 
403
{*        ch(x)                         -                  -           *}
 
404
{***********************************************************************}
 
405
function fcosh(x : float): float; assembler;
 
406
const
 
407
  one_half : float = 0.5;
 
408
var
 
409
  round_z : dword;
 
410
  temp    : extended;
 
411
asm
 
412
  FLDL2E                  
 
413
  FLD x                   
 
414
  FMULP                   
 
415
  FIST round_z            
 
416
  MOV DWORD PTR [temp],  00000000H
 
417
  MOV DWORD PTR [temp+4],80000000H
 
418
  FISUB round_z           
 
419
  MOV EAX, round_z   
 
420
  ADD EAX, 00003FFFH
 
421
  MOV DWORD PTR [temp+8],EAX
 
422
  F2XM1                   
 
423
  FLD1                    
 
424
  FADDP                   
 
425
  FLD TBYTE PTR [temp]     
 
426
  FMULP                   
 
427
  FST ST(1)          
 
428
  FLD1               
 
429
  FDIVRP ST(1), ST
 
430
  FADDP ST(1), ST
 
431
  FLD one_half       
 
432
  FMULP ST(1), ST    
 
433
end;
 
434
 
 
435
{***********************************************************************}
 
436
{*               function ftanh(X : Float) : Float;                    *}
 
437
{***********************************************************************}
 
438
{*      retourne la tangente hyperbolique de l'argument                *}
 
439
{*      th(x) = sh(x) / ch(x) *)                                       *}
 
440
{*      th(x) = [exp(x) - exp(-x)] / [exp(x) + exp(-x)]                *}
 
441
{*      methode : z = exp(x), ch(x) = (z - 1/z) / (z + 1/z)            *}
 
442
{*          z = 2^y, y = x.log2(e),                                    *}
 
443
{*          z = 2^f.2^i, f = frac(y), i = int(y)                       *}
 
444
{*      2^f est calcul� avec F2XM1, 2^i sans FSCALE                    *}
 
445
{***********************************************************************}
 
446
{*         st(0)                      st(1)               st(2)        *}
 
447
{*        log2(e)                       -                              *}
 
448
{*          x                        log2(e)                           *}
 
449
{*        z:=x.log2(e)                  -                              *}
 
450
{*          z                           -                              *}
 
451
{*       z - round(z)                   -                              *}
 
452
{*    2^(z - round(z)) - 1              -                              *}
 
453
{*          1                  2^(z - round(z)) - 1                    *}
 
454
{*    2^(z - round(z))                  -                              *}
 
455
{*      temp:=2^i              2^f:=2^(z - round(z))                   *}
 
456
{*         e^x                          -                              *}
 
457
{*         e^x                         e^x                -            *}
 
458
{*          1                           z                 z            *}
 
459
{*         1/z                          z                 z            *}
 
460
{*         1/z                          z               z-1/z          *}
 
461
{*        z+1/z                       z-1/z               -            *}
 
462
{*        th(x)                         -                 -            *}
 
463
{***********************************************************************}
 
464
function ftanh(x : float): float; assembler;
 
465
const
 
466
  one_half : float = 0.5;
 
467
var
 
468
  round_z : dword;
 
469
  temp    : extended;
 
470
asm                       
 
471
  FLDL2E                  
 
472
  FLD x                   
 
473
  FMULP                   
 
474
  FIST round_z            
 
475
  MOV DWORD PTR [temp],  00000000H
 
476
  MOV DWORD PTR [temp+4],80000000H
 
477
  FISUB round_z           
 
478
  MOV EAX, round_z   
 
479
  ADD EAX, 00003FFFH
 
480
  MOV DWORD PTR [temp+8],EAX
 
481
  F2XM1                   
 
482
  FLD1                    
 
483
  FADDP                   
 
484
  FLD TBYTE PTR [temp]     
 
485
  FMULP                   
 
486
  FST ST(1)          
 
487
  FLD1               
 
488
  FDIV  ST, ST(1)
 
489
  FSUB  ST(2), ST    
 
490
  FADDP ST(1), ST    
 
491
  FDIVP ST(1), ST    
 
492
end;
 
493
 
 
494
{***********************************************************************}
 
495
{*              function farcsinh(X : Float) : Float;                  *}
 
496
{***********************************************************************}
 
497
{* retourne l'arc sinus hyperbolique de l'argument                     *}
 
498
{*                       _________                                     *}
 
499
{* arg sh(x) = ln ( x + V x.x + 1 )                                    *}
 
500
{***********************************************************************}
 
501
{*       ST(0)            ST(1)             ST(2)          ST(3)       *}
 
502
{*       ln(2)              -                 -              -         *}
 
503
{*         x              ln(2)               -              -         *}
 
504
{*         x                x                ln(2)           -         *}
 
505
{*        x.x               x                ln(2)           -         *}
 
506
{*         1               x.x                x             ln(2)      *}
 
507
{*      x.x + 1             x                ln(2)           -         *}
 
508
{*      sqrt(x.x+1)         x                ln(2)           -         *}
 
509
{*       x + z            ln(2)               -              -         *}
 
510
{*      arg_sh(x)           -                 -              -         *}
 
511
{***********************************************************************}
 
512
function farcsinh(x : float): float; assembler;
 
513
asm                 
 
514
   FLDLN2           
 
515
   FLD X            
 
516
   FLD ST(0)        
 
517
   FMUL ST(0), ST   
 
518
   FLD1             
 
519
   FADDP ST(1), ST  
 
520
   FSQRT            
 
521
   FADDP ST(1), ST  
 
522
   FYL2X            
 
523
end;
 
524
 
 
525
{***********************************************************************}
 
526
{*             function farccosh(X : Float) : Float;                   *}
 
527
{***********************************************************************}
 
528
{* retourne l'arc cosinus hyperbolique de l'argument                   *}
 
529
{*                       ________                                      *}
 
530
{* arg ch(x) = ln ( x + V x.x - 1 )  x >=1                             *}
 
531
{***********************************************************************}
 
532
{*        ST(0)            ST(1)            ST(2)         ST(3)        *}
 
533
{*        ln(2)             -                -             -           *}
 
534
{*         x               ln(2)             -             -           *}
 
535
{*         x                x               ln(2)          -           *}
 
536
{*        x.x               x               ln(2)          -           *}
 
537
{*         1               x.x               x            ln(2)        *}
 
538
{*       x.x - 1            x               ln(2)          -           *}
 
539
{*      sqrt(x2-1)          x               ln(2)          -           *}
 
540
{*       x + z             ln(2)             -             -           *}
 
541
{*      arg_ch(x)           -                -             -           *}
 
542
{***********************************************************************}
 
543
function farccosh(x : float): float; assembler;
 
544
asm                 
 
545
   FLDLN2
 
546
   FLD X            
 
547
   FLD ST(0)        
 
548
   FMUL ST(0), ST  
 
549
   FLD1            
 
550
   FSUBP ST(1), ST  
 
551
   FSQRT            
 
552
   FADDP ST(1), ST  
 
553
   FYL2X            
 
554
end;
 
555
 
 
556
{***********************************************************************}
 
557
{*            function farctanh(X : Float) : Float;                    *}
 
558
{***********************************************************************}
 
559
{*      retourne l'arc tangente hyperbolique de l'argument             *}
 
560
{*      arg th(x) = 1/2 ln [ (1 + x) / (1 - x) ]                       *}
 
561
{***********************************************************************}
 
562
{*      ST(0)             ST(1)             ST(2)          ST(3)       *}
 
563
{*      ln(2)              -                  -              -         *}
 
564
{*       x                ln(2)               -              -         *}
 
565
{*       x                 x                ln(2)            -         *}
 
566
{*       1                 x                  x            ln(2)       *}
 
567
{*       1                 x                1 + x          ln(2)       *}
 
568
{*     1 - x             1 + x              ln(2)            -         *}
 
569
{*    1+x/1-x             ln(2)               -              -         *}
 
570
{*     ln(z)               -                  -              -         *}
 
571
{***********************************************************************}
 
572
function farctanh(x : float): float; assembler;
 
573
asm                 
 
574
   FLDLN2                
 
575
   FLD X                 
 
576
   FLD ST(0)             
 
577
   FLD1
 
578
   FADD ST(2),ST
 
579
   FSUBRP ST(1),ST
 
580
   FDIVP ST(1),ST
 
581
   FYL2X
 
582
end;