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