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