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