|
|
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.