|
|
1.1 root 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: * Redistribution and use in source and binary forms are permitted
10: * provided that: (1) source distributions retain this entire copyright
11: * notice and comment, and (2) distributions including binaries display
12: * the following acknowledgement: ``This product includes software
13: * developed by the University of California, Berkeley and its contributors''
14: * in the documentation or other materials provided with the distribution
15: * and in all advertising materials mentioning features or use of this
16: * software. Neither the name of the University nor the names of its
17: * contributors may be used to endorse or promote products derived
18: * from this software without specific prior written permission.
19: * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
20: * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
21: * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
22: *
23: * @(#)support.s 5.2 (Berkeley) 5/17/90
24: */
25:
26: .text
27: .globl _copysign, _finite, _scalb, _logb, _drem, _pow_p, _atan2__A
28:
29: | copysign(x,y)
30: | returns x with the sign of y.
31: _copysign:
32: movl sp@(4),d0
33: movl sp@(8),d1
34: tstw sp@(12)
35: jmi Lneg
36: bclr #31,d0
37: rts
38: Lneg:
39: bset #31,d0
40: rts
41:
42: | finite(x)
43: | returns the value TRUE if -INF < x < +INF and returns FALSE otherwise.
44: _finite:
45: movw #0x7FF0,d0
46: movw sp@(4),d1
47: andw d0,d1
48: cmpw d0,d1
49: beq Lnotfin
50: moveq #1,d0
51: rts
52: Lnotfin:
53: clrl d0
54: rts
55:
56: | scalb(x, N)
57: | returns x * (2**N), for integer values N.
58: _scalb:
59: fmoved sp@(4),fp0
60: fbeq Ldone
61: fscalel sp@(12),fp0
62: Ldone:
63: fmoved fp0,sp@-
64: movel sp@+,d0
65: movel sp@+,d1
66: rts
67:
68: | logb(x)
69: | returns the unbiased exponent of x, a signed integer in double precision,
70: | except that logb(0) is -INF, logb(INF) is +INF, and logb(NAN) is that NAN.
71: _logb:
72: movw sp@(4),d0
73: movw #0x7FF0,d1 | exponent bits
74: andw d1,d0 | mask off all else
75: cmpw d1,d0 | max exponent?
76: bne Lfinite | no, is finite
77: fmoved sp@(4),fp0 | yes, infinite or NaN
78: fbun Ldone | NaN returns NaN
79: fabsx fp0 | +-inf returns inf
80: jra Ldone
81: Lfinite:
82: fmoved sp@(4),fp0 | get entire number
83: fbne Lnonz | zero?
84: flog2x fp0 | yes, log(0) a convenient source of -inf
85: jra Ldone
86: Lnonz:
87: fgetexpx fp0 | get exponent
88: jra Ldone
89:
90: | drem(x,y)
91: | returns x REM y = x - [x/y]*y , where [x/y] is the integer nearest x/y;
92: | in half way case, choose the even one.
93: _drem:
94: fmoved sp@(4),fp0
95: fremd sp@(12),fp0
96: fmoved fp0,sp@-
97: movel sp@+,d0
98: movel sp@+,d1
99: rts
100:
101: | pow_p(x,y)
102: | return x**y for x with sign=1 and finite y
103: _pow_p:
104: flognd sp@(4),fp0
105: fmuld sp@(12),fp0
106: fetoxx fp0
107: fmoved fp0,sp@-
108: movel sp@+,d0
109: movel sp@+,d1
110: rts
111:
112: | atan2__A(y,x)
113: | compute atan2(y,x) where x,y are finite and non-zero
114: | called by atan2() after weeding out all the special cases
115: _atan2__A:
116: moveq #0,d0 | sign of result
117: fmoved sp@(4),fp0 | get y
118: fboge Lypos | <0?
119: moveq #1,d0 | yes, result is neg
120: fnegx fp0 | make y pos
121: Lypos:
122: fmoved sp@(12),fp1 | get x
123: fboge Lxpos | <0?
124: fnegx fp1 | yes, make x pos
125: fdivx fp1,fp0 | y/x
126: fatanx fp0,fp1 | atan(y/x)
127: fmovecr #0,fp0 | get pi
128: fsubx fp1,fp0 | pi - atan(y/x)
129: jra Lsetsign
130: Lxpos:
131: fdivx fp1,fp0 | y/x
132: fatanx fp0 | atan(y/x)
133: Lsetsign:
134: tstl d0 | should be neg?
135: jeq Lrpos | no, all done
136: fnegx fp0 | yes, negate
137: Lrpos:
138: fmoved fp0,sp@-
139: movel sp@+,d0
140: movel sp@+,d1
141: rts
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.