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) 06/30/88 23 */ 24 .data 25 .align 2 26_sccsid: 27.asciz "@(#)support.s 1.3 (Berkeley) 8/21/85; 5.3 (ucb.elefunt) 06/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 54Lz: 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 71Ln: 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 741: 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 901: 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 118ovfl: 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 123unfl: movq $0,r0 124ret1: 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) 154C1: 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 160loop: 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 173C2: 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 183E1: 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 189C3: 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 197C4: 198 subd2 r2,r0 #x-y 199E2: 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 208C5: 209 bisw2 r8,r0 #put r8 into x's exponent field 210 ret 211Rop: #Reserved operand 212 pushl $EDOM 213 calls $1,_infnan #generate reserved op fault 214 ret 215Ret: 216 movq $0x8000,r0 #propagate reserved op 217 ret 218