![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to support.s CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDTahoe / usr.lib / libm / vax|
Return to support.s CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / usr.lib / libm / vax |
1.1 root 1: /*
2: * Copyright (c) 1985 Regents of the University of California.
3: * All rights reserved.
4: *
5: * Redistribution and use in source and binary forms are permitted
6: * provided that the above copyright notice and this paragraph are
7: * duplicated in all such forms and that any documentation,
8: * advertising materials, and other materials related to such
9: * distribution and use acknowledge that the software was developed
10: * by the University of California, Berkeley. The name of the
11: * University may not be used to endorse or promote products derived
12: * from this software without specific prior written permission.
13: * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
14: * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
15: * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
16: *
17: * All recipients should regard themselves as participants in an ongoing
18: * research project and hence should feel obligated to report their
19: * experiences (good or bad) with these elementary function codes, using
20: * the sendbug(8) program, to the authors.
21: *
22: * @(#)support.s 5.3 (Berkeley) 6/30/88
23: */
24: .data
25: .align 2
26: _sccsid:
27: .asciz "@(#)support.s 1.3 (Berkeley) 8/21/85; 5.3 (ucb.elefunt) 6/30/88"
28:
29: /*
30: * copysign(x,y),
31: * logb(x),
32: * scalb(x,N),
33: * finite(x),
34: * drem(x,y),
35: * Coded in vax assembly language by K.C. Ng, 3/14/85.
36: * Revised by K.C. Ng on 4/9/85.
37: */
38:
39: /*
40: * double copysign(x,y)
41: * double x,y;
42: */
43: .globl _copysign
44: .text
45: .align 1
46: _copysign:
47: .word 0x4
48: movq 4(ap),r0 # load x into r0
49: bicw3 $0x807f,r0,r2 # mask off the exponent of x
50: beql Lz # if zero or reserved op then return x
51: bicw3 $0x7fff,12(ap),r2 # copy the sign bit of y into r2
52: bicw2 $0x8000,r0 # replace x by |x|
53: bisw2 r2,r0 # copy the sign bit of y to x
54: Lz: ret
55:
56: /*
57: * double logb(x)
58: * double x;
59: */
60: .globl _logb
61: .text
62: .align 1
63: _logb:
64: .word 0x0
65: bicl3 $0xffff807f,4(ap),r0 # mask off the exponent of x
66: beql Ln
67: ashl $-7,r0,r0 # get the bias exponent
68: subl2 $129,r0 # get the unbias exponent
69: cvtld r0,r0 # return the answer in double
70: ret
71: Ln: movq 4(ap),r0 # r0:1 = x (zero or reserved op)
72: bneq 1f # simply return if reserved op
73: movq $0x0000fe00ffffcfff,r0 # -2147483647.0
74: 1: ret
75:
76: /*
77: * long finite(x)
78: * double x;
79: */
80: .globl _finite
81: .text
82: .align 1
83: _finite:
84: .word 0x0000
85: bicw3 $0x7f,4(ap),r0 # mask off the mantissa
86: cmpw r0,$0x8000 # to see if x is the reserved op
87: beql 1f # if so, return FALSE (0)
88: movl $1,r0 # else return TRUE (1)
89: ret
90: 1: clrl r0
91: ret
92:
93: /*
94: * double scalb(x,N)
95: * double x; int N;
96: */
97: .globl _scalb
98: .set ERANGE,34
99: .text
100: .align 1
101: _scalb:
102: .word 0xc
103: movq 4(ap),r0
104: bicl3 $0xffff807f,r0,r3
105: beql ret1 # 0 or reserved operand
106: movl 12(ap),r2
107: cmpl r2,$0x12c
108: bgeq ovfl
109: cmpl r2,$-0x12c
110: bleq unfl
111: ashl $7,r2,r2
112: addl2 r2,r3
113: bleq unfl
114: cmpl r3,$0x8000
115: bgeq ovfl
116: addl2 r2,r0
117: ret
118: ovfl: pushl $ERANGE
119: calls $1,_infnan # if it returns
120: bicw3 $0x7fff,4(ap),r2 # get the sign of input arg
121: bisw2 r2,r0 # re-attach the sign to r0/1
122: ret
123: unfl: movq $0,r0
124: ret1: ret
125:
126: /*
127: * DREM(X,Y)
128: * RETURN X REM Y =X-N*Y, N=[X/Y] ROUNDED (ROUNDED TO EVEN IN THE HALF WAY CASE)
129: * DOUBLE PRECISION (VAX D format 56 bits)
130: * CODED IN VAX ASSEMBLY LANGUAGE BY K.C. NG, 4/8/85.
131: */
132: .globl _drem
133: .set EDOM,33
134: .text
135: .align 1
136: _drem:
137: .word 0xffc
138: subl2 $12,sp
139: movq 4(ap),r0 #r0=x
140: movq 12(ap),r2 #r2=y
141: jeql Rop #if y=0 then generate reserved op fault
142: bicw3 $0x007f,r0,r4 #check if x is Rop
143: cmpw r4,$0x8000
144: jeql Ret #if x is Rop then return Rop
145: bicl3 $0x007f,r2,r4 #check if y is Rop
146: cmpw r4,$0x8000
147: jeql Ret #if y is Rop then return Rop
148: bicw2 $0x8000,r2 #y := |y|
149: movw $0,-4(fp) #-4(fp) = nx := 0
150: cmpw r2,$0x1c80 #yexp ? 57
151: bgtr C1 #if yexp > 57 goto C1
152: addw2 $0x1c80,r2 #scale up y by 2**57
153: movw $0x1c80,-4(fp) #nx := 57 (exponent field)
154: C1:
155: movw -4(fp),-8(fp) #-8(fp) = nf := nx
156: bicw3 $0x7fff,r0,-12(fp) #-12(fp) = sign of x
157: bicw2 $0x8000,r0 #x := |x|
158: movq r2,r10 #y1 := y
159: bicl2 $0xffff07ff,r11 #clear the last 27 bits of y1
160: loop:
161: cmpd r0,r2 #x ? y
162: bleq E1 #if x <= y goto E1
163: /* begin argument reduction */
164: movq r2,r4 #t =y
165: movq r10,r6 #t1=y1
166: bicw3 $0x807f,r0,r8 #xexp= exponent of x
167: bicw3 $0x807f,r2,r9 #yexp= exponent fo y
168: subw2 r9,r8 #xexp-yexp
169: subw2 $0x0c80,r8 #k=xexp-yexp-25(exponent bit field)
170: blss C2 #if k<0 goto C2
171: addw2 r8,r4 #t +=k
172: addw2 r8,r6 #t1+=k, scale up t and t1
173: C2:
174: divd3 r4,r0,r8 #x/t
175: cvtdl r8,r8 #n=[x/t] truncated
176: cvtld r8,r8 #float(n)
177: subd2 r6,r4 #t:=t-t1
178: muld2 r8,r4 #n*(t-t1)
179: muld2 r8,r6 #n*t1
180: subd2 r6,r0 #x-n*t1
181: subd2 r4,r0 #(x-n*t1)-n*(t-t1)
182: brb loop
183: E1:
184: movw -4(fp),r6 #r6=nx
185: beql C3 #if nx=0 goto C3
186: addw2 r6,r0 #x:=x*2**57 scale up x by nx
187: movw $0,-4(fp) #clear nx
188: brb loop
189: C3:
190: movq r2,r4 #r4 = y
191: subw2 $0x80,r4 #r4 = y/2
192: cmpd r0,r4 #x:y/2
193: blss E2 #if x < y/2 goto E2
194: bgtr C4 #if x > y/2 goto C4
195: cvtdl r8,r8 #ifix(float(n))
196: blbc r8,E2 #if the last bit is zero, goto E2
197: C4:
198: subd2 r2,r0 #x-y
199: E2:
200: xorw2 -12(fp),r0 #x^sign (exclusive or)
201: movw -8(fp),r6 #r6=nf
202: bicw3 $0x807f,r0,r8 #r8=exponent of x
203: bicw2 $0x7f80,r0 #clear the exponent of x
204: subw2 r6,r8 #r8=xexp-nf
205: bgtr C5 #if xexp-nf is positive goto C5
206: movw $0,r8 #clear r8
207: movq $0,r0 #x underflow to zero
208: C5:
209: bisw2 r8,r0 #put r8 into x's exponent field
210: ret
211: Rop: #Reserved operand
212: pushl $EDOM
213: calls $1,_infnan #generate reserved op fault
214: ret
215: Ret:
216: movq $0x8000,r0 #propagate reserved op
217: ret
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.