|
|
1.1 root 1: # Copyright (c) 1985 Regents of the University of California.
2: # All rights reserved.
3: #
4: # Redistribution and use in source and binary forms are permitted
5: # provided that the above copyright notice and this paragraph are
6: # duplicated in all such forms and that any documentation,
7: # advertising materials, and other materials related to such
8: # distribution and use acknowledge that the software was developed
9: # by the University of California, Berkeley. The name of the
10: # University may not be used to endorse or promote products derived
11: # from this software without specific prior written permission.
12: # THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
13: # IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
14: # WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
15: #
16: # All recipients should regard themselves as participants in an ongoing
17: # research project and hence should feel obligated to report their
18: # experiences (good or bad) with these elementary function codes, using
19: # the sendbug(8) program, to the authors.
20: #
21: # @(#)atan2.s 5.3 (Berkeley) 6/30/88
22: #
23: .data
24: .align 2
25: _sccsid:
26: .asciz "@(#)atan2.s 1.2 (Berkeley) 8/21/85; 5.3 (ucb.elefunt) 6/30/88"
27:
28: # ATAN2(Y,X)
29: # RETURN ARG (X+iY)
30: # VAX D FORMAT (56 BITS PRECISION)
31: # CODED IN VAX ASSEMBLY LANGUAGE BY K.C. NG, 4/16/85;
32: #
33: #
34: # Method :
35: # 1. Reduce y to positive by atan2(y,x)=-atan2(-y,x).
36: # 2. Reduce x to positive by (if x and y are unexceptional):
37: # ARG (x+iy) = arctan(y/x) ... if x > 0,
38: # ARG (x+iy) = pi - arctan[y/(-x)] ... if x < 0,
39: # 3. According to the integer k=4t+0.25 truncated , t=y/x, the argument
40: # is further reduced to one of the following intervals and the
41: # arctangent of y/x is evaluated by the corresponding formula:
42: #
43: # [0,7/16] atan(y/x) = t - t^3*(a1+t^2*(a2+...(a10+t^2*a11)...)
44: # [7/16,11/16] atan(y/x) = atan(1/2) + atan( (y-x/2)/(x+y/2) )
45: # [11/16.19/16] atan(y/x) = atan( 1 ) + atan( (y-x)/(x+y) )
46: # [19/16,39/16] atan(y/x) = atan(3/2) + atan( (y-1.5x)/(x+1.5y) )
47: # [39/16,INF] atan(y/x) = atan(INF) + atan( -x/y )
48: #
49: # Special cases:
50: # Notations: atan2(y,x) == ARG (x+iy) == ARG(x,y).
51: #
52: # ARG( NAN , (anything) ) is NaN;
53: # ARG( (anything), NaN ) is NaN;
54: # ARG(+(anything but NaN), +-0) is +-0 ;
55: # ARG(-(anything but NaN), +-0) is +-PI ;
56: # ARG( 0, +-(anything but 0 and NaN) ) is +-PI/2;
57: # ARG( +INF,+-(anything but INF and NaN) ) is +-0 ;
58: # ARG( -INF,+-(anything but INF and NaN) ) is +-PI;
59: # ARG( +INF,+-INF ) is +-PI/4 ;
60: # ARG( -INF,+-INF ) is +-3PI/4;
61: # ARG( (anything but,0,NaN, and INF),+-INF ) is +-PI/2;
62: #
63: # Accuracy:
64: # atan2(y,x) returns the exact ARG(x+iy) nearly rounded.
65: #
66: .text
67: .align 1
68: .globl _atan2
69: _atan2 :
70: .word 0x0ff4
71: movq 4(ap),r2 # r2 = y
72: movq 12(ap),r4 # r4 = x
73: bicw3 $0x7f,r2,r0
74: bicw3 $0x7f,r4,r1
75: cmpw r0,$0x8000 # y is the reserved operand
76: jeql resop
77: cmpw r1,$0x8000 # x is the reserved operand
78: jeql resop
79: subl2 $8,sp
80: bicw3 $0x7fff,r2,-4(fp) # copy y sign bit to -4(fp)
81: bicw3 $0x7fff,r4,-8(fp) # copy x sign bit to -8(fp)
82: cmpd r4,$0x4080 # x = 1.0 ?
83: bneq xnot1
84: movq r2,r0
85: bicw2 $0x8000,r0 # t = |y|
86: movq r0,r2 # y = |y|
87: brb begin
88: xnot1:
89: bicw3 $0x807f,r2,r11 # yexp
90: jeql yeq0 # if y=0 goto yeq0
91: bicw3 $0x807f,r4,r10 # xexp
92: jeql pio2 # if x=0 goto pio2
93: subw2 r10,r11 # k = yexp - xexp
94: cmpw r11,$0x2000 # k >= 64 (exp) ?
95: jgeq pio2 # atan2 = +-pi/2
96: divd3 r4,r2,r0 # t = y/x never overflow
97: bicw2 $0x8000,r0 # t > 0
98: bicw2 $0xff80,r2 # clear the exponent of y
99: bicw2 $0xff80,r4 # clear the exponent of x
100: bisw2 $0x4080,r2 # normalize y to [1,2)
101: bisw2 $0x4080,r4 # normalize x to [1,2)
102: subw2 r11,r4 # scale x so that yexp-xexp=k
103: begin:
104: cmpw r0,$0x411c # t : 39/16
105: jgeq L50
106: addl3 $0x180,r0,r10 # 8*t
107: cvtrfl r10,r10 # [8*t] rounded to int
108: ashl $-1,r10,r10 # [8*t]/2
109: casel r10,$0,$4
110: L1:
111: .word L20-L1
112: .word L20-L1
113: .word L30-L1
114: .word L40-L1
115: .word L40-L1
116: L10:
117: movq $0xb4d9940f985e407b,r6 # Hi=.98279372324732906796d0
118: movq $0x21b1879a3bc2a2fc,r8 # Lo=-.17092002525602665777d-17
119: subd3 r4,r2,r0 # y-x
120: addw2 $0x80,r0 # 2(y-x)
121: subd2 r4,r0 # 2(y-x)-x
122: addw2 $0x80,r4 # 2x
123: movq r2,r10
124: addw2 $0x80,r10 # 2y
125: addd2 r10,r2 # 3y
126: addd2 r4,r2 # 3y+2x
127: divd2 r2,r0 # (2y-3x)/(2x+3y)
128: brw L60
129: L20:
130: cmpw r0,$0x3280 # t : 2**(-28)
131: jlss L80
132: clrq r6 # Hi=r6=0, Lo=r8=0
133: clrq r8
134: brw L60
135: L30:
136: movq $0xda7b2b0d63383fed,r6 # Hi=.46364760900080611433d0
137: movq $0xf0ea17b2bf912295,r8 # Lo=.10147340032515978826d-17
138: movq r2,r0
139: addw2 $0x80,r0 # 2y
140: subd2 r4,r0 # 2y-x
141: addw2 $0x80,r4 # 2x
142: addd2 r2,r4 # 2x+y
143: divd2 r4,r0 # (2y-x)/(2x+y)
144: brb L60
145: L50:
146: movq $0x68c2a2210fda40c9,r6 # Hi=1.5707963267948966135d1
147: movq $0x06e0145c26332326,r8 # Lo=.22517417741562176079d-17
148: cmpw r0,$0x5100 # y : 2**57
149: bgeq L90
150: divd3 r2,r4,r0
151: bisw2 $0x8000,r0 # -x/y
152: brb L60
153: L40:
154: movq $0x68c2a2210fda4049,r6 # Hi=.78539816339744830676d0
155: movq $0x06e0145c263322a6,r8 # Lo=.11258708870781088040d-17
156: subd3 r4,r2,r0 # y-x
157: addd2 r4,r2 # y+x
158: divd2 r2,r0 # (y-x)/(y+x)
159: L60:
160: movq r0,r10
161: muld2 r0,r0
162: polyd r0,$12,ptable
163: muld2 r10,r0
164: subd2 r0,r8
165: addd3 r8,r10,r0
166: addd2 r6,r0
167: L80:
168: movw -8(fp),r2
169: bneq pim
170: bisw2 -4(fp),r0 # return sign(y)*r0
171: ret
172: L90: # x >= 2**25
173: movq r6,r0
174: brb L80
175: pim:
176: subd3 r0,$0x68c2a2210fda4149,r0 # pi-t
177: bisw2 -4(fp),r0
178: ret
179: yeq0:
180: movw -8(fp),r2
181: beql zero # if sign(x)=1 return pi
182: movq $0x68c2a2210fda4149,r0 # pi=3.1415926535897932270d1
183: ret
184: zero:
185: clrq r0 # return 0
186: ret
187: pio2:
188: movq $0x68c2a2210fda40c9,r0 # pi/2=1.5707963267948966135d1
189: bisw2 -4(fp),r0 # return sign(y)*pi/2
190: ret
191: resop:
192: movq $0x8000,r0 # propagate the reserved operand
193: ret
194: .align 2
195: ptable:
196: .quad 0xb50f5ce96e7abd60
197: .quad 0x51e44a42c1073e02
198: .quad 0x3487e3289643be35
199: .quad 0xdb62066dffba3e54
200: .quad 0xcf8e2d5199abbe70
201: .quad 0x26f39cb884883e88
202: .quad 0x135117d18998be9d
203: .quad 0x602ce9742e883eba
204: .quad 0xa35ad0be8e38bee3
205: .quad 0xffac922249243f12
206: .quad 0x7f14ccccccccbf4c
207: .quad 0xaa8faaaaaaaa3faa
208: .quad 0x0000000000000000
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.