projects / unix-history / blame
| Commit | Line | Data |
|---|---|---|
| 8b7ef7ca KB |
1 | /*- |
| 2 | * Copyright (c) 1990 The Regents of the University of California. | |
| 3 | * All rights reserved. | |
| 4 | * | |
| 5 | * This code is derived from software contributed to Berkeley by | |
| 6 | * the Systems Programming Group of the University of Utah Computer | |
| 7 | * Science Department. | |
| 8 | * | |
| 9 | * %sccs.include.redist.c% | |
| 10 | * | |
| 5937ccb9 | 11 | * @(#)support.s 5.2 (Berkeley) %G% |
| 8b7ef7ca KB |
12 | */ |
| 13 | ||
| 14 | .text | |
| 15 | .globl _copysign, _finite, _scalb, _logb, _drem, _pow_p, _atan2__A | |
| 16 | ||
| 17 | | copysign(x,y) | |
| 18 | | returns x with the sign of y. | |
| 19 | _copysign: | |
| 20 | movl sp@(4),d0 | |
| 21 | movl sp@(8),d1 | |
| 22 | tstw sp@(12) | |
| 23 | jmi Lneg | |
| 24 | bclr #31,d0 | |
| 25 | rts | |
| 26 | Lneg: | |
| 27 | bset #31,d0 | |
| 28 | rts | |
| 29 | ||
| 30 | | finite(x) | |
| 31 | | returns the value TRUE if -INF < x < +INF and returns FALSE otherwise. | |
| 32 | _finite: | |
| 33 | movw #0x7FF0,d0 | |
| 34 | movw sp@(4),d1 | |
| 35 | andw d0,d1 | |
| 36 | cmpw d0,d1 | |
| 37 | beq Lnotfin | |
| 38 | moveq #1,d0 | |
| 39 | rts | |
| 40 | Lnotfin: | |
| 41 | clrl d0 | |
| 42 | rts | |
| 43 | ||
| 44 | | scalb(x, N) | |
| 45 | | returns x * (2**N), for integer values N. | |
| 46 | _scalb: | |
| 47 | fmoved sp@(4),fp0 | |
| 48 | fbeq Ldone | |
| 5937ccb9 | 49 | fscalel sp@(12),fp0 |
| 8b7ef7ca KB |
50 | Ldone: |
| 51 | fmoved fp0,sp@- | |
| 52 | movel sp@+,d0 | |
| 53 | movel sp@+,d1 | |
| 54 | rts | |
| 55 | ||
| 56 | | logb(x) | |
| 57 | | returns the unbiased exponent of x, a signed integer in double precision, | |
| 58 | | except that logb(0) is -INF, logb(INF) is +INF, and logb(NAN) is that NAN. | |
| 59 | _logb: | |
| 60 | movw sp@(4),d0 | |
| 61 | movw #0x7FF0,d1 | exponent bits | |
| 62 | andw d1,d0 | mask off all else | |
| 63 | cmpw d1,d0 | max exponent? | |
| 64 | bne Lfinite | no, is finite | |
| 65 | fmoved sp@(4),fp0 | yes, infinite or NaN | |
| 66 | fbun Ldone | NaN returns NaN | |
| 67 | fabsx fp0 | +-inf returns inf | |
| 68 | jra Ldone | |
| 69 | Lfinite: | |
| 70 | fmoved sp@(4),fp0 | get entire number | |
| 71 | fbne Lnonz | zero? | |
| 72 | flog2x fp0 | yes, log(0) a convenient source of -inf | |
| 73 | jra Ldone | |
| 74 | Lnonz: | |
| 75 | fgetexpx fp0 | get exponent | |
| 76 | jra Ldone | |
| 77 | ||
| 78 | | drem(x,y) | |
| 79 | | returns x REM y = x - [x/y]*y , where [x/y] is the integer nearest x/y; | |
| 80 | | in half way case, choose the even one. | |
| 81 | _drem: | |
| 82 | fmoved sp@(4),fp0 | |
| 83 | fremd sp@(12),fp0 | |
| 84 | fmoved fp0,sp@- | |
| 85 | movel sp@+,d0 | |
| 86 | movel sp@+,d1 | |
| 87 | rts | |
| 88 | ||
| 89 | | pow_p(x,y) | |
| 90 | | return x**y for x with sign=1 and finite y | |
| 91 | _pow_p: | |
| 92 | flognd sp@(4),fp0 | |
| 93 | fmuld sp@(12),fp0 | |
| 94 | fetoxx fp0 | |
| 95 | fmoved fp0,sp@- | |
| 96 | movel sp@+,d0 | |
| 97 | movel sp@+,d1 | |
| 98 | rts | |
| 99 | ||
| 100 | | atan2__A(y,x) | |
| 101 | | compute atan2(y,x) where x,y are finite and non-zero | |
| 102 | | called by atan2() after weeding out all the special cases | |
| 103 | _atan2__A: | |
| 104 | moveq #0,d0 | sign of result | |
| 105 | fmoved sp@(4),fp0 | get y | |
| 106 | fboge Lypos | <0? | |
| 107 | moveq #1,d0 | yes, result is neg | |
| 108 | fnegx fp0 | make y pos | |
| 109 | Lypos: | |
| 110 | fmoved sp@(12),fp1 | get x | |
| 111 | fboge Lxpos | <0? | |
| 112 | fnegx fp1 | yes, make x pos | |
| 113 | fdivx fp1,fp0 | y/x | |
| 114 | fatanx fp0,fp1 | atan(y/x) | |
| 115 | fmovecr #0,fp0 | get pi | |
| 116 | fsubx fp1,fp0 | pi - atan(y/x) | |
| 117 | jra Lsetsign | |
| 118 | Lxpos: | |
| 119 | fdivx fp1,fp0 | y/x | |
| 120 | fatanx fp0 | atan(y/x) | |
| 121 | Lsetsign: | |
| 122 | tstl d0 | should be neg? | |
| 123 | jeq Lrpos | no, all done | |
| 124 | fnegx fp0 | yes, negate | |
| 125 | Lrpos: | |
| 126 | fmoved fp0,sp@- | |
| 127 | movel sp@+,d0 | |
| 128 | movel sp@+,d1 | |
| 129 | rts |