4.3BSD - /usr/src/usr.lib/libm/VAX/support.s

   1: /*
   2:  * Copyright (c) 1985 Regents of the University of California.
   3:  *
   4:  * Use and reproduction of this software are granted  in  accordance  with
   5:  * the terms and conditions specified in  the  Berkeley  Software  License
   6:  * Agreement (in particular, this entails acknowledgement of the programs'
   7:  * source, and inclusion of this notice) with the additional understanding
   8:  * that  all  recipients  should regard themselves as participants  in  an
   9:  * ongoing  research  project and hence should  feel  obligated  to report
  10:  * their  experiences (good or bad) with these elementary function  codes,
  11:  * using "sendbug 4bsd-bugs@BERKELEY", to the authors.
  12:  *
  13:  * @(#)support.s	1.3 (Berkeley) 8/21/85
  14:  *
  15:  * copysign(x,y),
  16:  * logb(x),
  17:  * scalb(x,N),
  18:  * finite(x),
  19:  * drem(x,y),
  20:  * Coded in vax assembly language by K.C. Ng,  3/14/85.
  21:  * Revised by K.C. Ng on 4/9/85.
  22:  */
  23: 
  24: /*
  25:  * double copysign(x,y)
  26:  * double x,y;
  27:  */
  28:         .globl  _copysign
  29:         .text
  30:         .align  1
  31: _copysign:
  32:         .word   0x4
  33:         movq    4(ap),r0                # load x into r0
  34:         bicw3   $0x807f,r0,r2           # mask off the exponent of x
  35:         beql    Lz                      # if zero or reserved op then return x
  36:         bicw3   $0x7fff,12(ap),r2       # copy the sign bit of y into r2
  37:         bicw2   $0x8000,r0              # replace x by |x|
  38:         bisw2   r2,r0                   # copy the sign bit of y to x
  39: Lz:     ret
  40: 
  41: /*
  42:  * double logb(x)
  43:  * double x;
  44:  */
  45:         .globl  _logb
  46:         .text
  47:         .align  1
  48: _logb:
  49:         .word   0x0
  50:         bicl3   $0xffff807f,4(ap),r0    # mask off the exponent of x
  51:         beql    Ln
  52:         ashl    $-7,r0,r0               # get the bias exponent
  53:         subl2   $129,r0                 # get the unbias exponent
  54:         cvtld   r0,r0                   # return the answer in double
  55:         ret
  56: Ln:     movq    4(ap),r0                # r0:1 = x (zero or reserved op)
  57:         bneq    1f                      # simply return if reserved op
  58:         movq    $0x0000fe00ffffcfff,r0  # -2147483647.0
  59: 1:      ret
  60: 
  61: /*
  62:  * long finite(x)
  63:  * double x;
  64:  */
  65:         .globl  _finite
  66:         .text
  67:         .align  1
  68: _finite:
  69:         .word   0x0000
  70:         bicw3   $0x7f,4(ap),r0          # mask off the mantissa
  71:         cmpw    r0,$0x8000              # to see if x is the reserved op
  72:         beql    1f                      # if so, return FALSE (0)
  73:         movl    $1,r0                   # else return TRUE (1)
  74:         ret
  75: 1:      clrl    r0
  76:         ret
  77: 
  78: /*
  79:  * double scalb(x,N)
  80:  * double x; int N;
  81:  */
  82:         .globl  _scalb
  83:         .set    ERANGE,34
  84:         .text
  85:         .align  1
  86: _scalb:
  87:         .word   0xc
  88:         movq    4(ap),r0
  89:         bicl3   $0xffff807f,r0,r3
  90:         beql    ret1                    # 0 or reserved operand
  91:         movl    12(ap),r2
  92:         cmpl    r2,$0x12c
  93:         bgeq    ovfl
  94:         cmpl    r2,$-0x12c
  95:         bleq    unfl
  96:         ashl    $7,r2,r2
  97:         addl2   r2,r3
  98:         bleq    unfl
  99:         cmpl    r3,$0x8000
 100:         bgeq    ovfl
 101:         addl2   r2,r0
 102:         ret
 103: ovfl:   pushl   $ERANGE
 104:         calls   $1,_infnan              # if it returns
 105:         bicw3   $0x7fff,4(ap),r2        # get the sign of input arg
 106:         bisw2   r2,r0                   # re-attach the sign to r0/1
 107:         ret
 108: unfl:   movq    $0,r0
 109: ret1:   ret
 110: 
 111: /*
 112:  * DREM(X,Y)
 113:  * RETURN X REM Y =X-N*Y, N=[X/Y] ROUNDED (ROUNDED TO EVEN IN THE HALF WAY CASE)
 114:  * DOUBLE PRECISION (VAX D format 56 bits)
 115:  * CODED IN VAX ASSEMBLY LANGUAGE BY K.C. NG, 4/8/85.
 116:  */
 117:         .globl  _drem
 118:         .set    EDOM,33
 119:         .text
 120:         .align  1
 121: _drem:
 122:         .word   0xffc
 123:         subl2   $12,sp
 124:         movq    4(ap),r0                #r0=x
 125:         movq    12(ap),r2               #r2=y
 126:         jeql    Rop                     #if y=0 then generate reserved op fault
 127:         bicw3   $0x007f,r0,r4           #check if x is Rop
 128:         cmpw    r4,$0x8000
 129:         jeql    Ret                     #if x is Rop then return Rop
 130:         bicl3   $0x007f,r2,r4           #check if y is Rop
 131:         cmpw    r4,$0x8000
 132:         jeql    Ret                     #if y is Rop then return Rop
 133:         bicw2   $0x8000,r2              #y  := |y|
 134:         movw    $0,-4(fp)               #-4(fp) = nx := 0
 135:         cmpw    r2,$0x1c80              #yexp ? 57
 136:         bgtr    C1                      #if yexp > 57 goto C1
 137:         addw2   $0x1c80,r2              #scale up y by 2**57
 138:         movw    $0x1c80,-4(fp)          #nx := 57 (exponent field)
 139: C1:
 140:         movw    -4(fp),-8(fp)           #-8(fp) = nf := nx
 141:         bicw3   $0x7fff,r0,-12(fp)      #-12(fp) = sign of x
 142:         bicw2   $0x8000,r0              #x  := |x|
 143:         movq    r2,r10                  #y1 := y
 144:         bicl2   $0xffff07ff,r11         #clear the last 27 bits of y1
 145: loop:
 146:         cmpd    r0,r2                   #x ? y
 147:         bleq    E1                      #if x <= y goto E1
 148:  /* begin argument reduction */
 149:         movq    r2,r4                   #t =y
 150:         movq    r10,r6                  #t1=y1
 151:         bicw3   $0x807f,r0,r8           #xexp= exponent of x
 152:         bicw3   $0x807f,r2,r9           #yexp= exponent fo y
 153:         subw2   r9,r8                   #xexp-yexp
 154:         subw2   $0x0c80,r8              #k=xexp-yexp-25(exponent bit field)
 155:         blss    C2                      #if k<0 goto C2
 156:         addw2   r8,r4                   #t +=k
 157:         addw2   r8,r6                   #t1+=k, scale up t and t1
 158: C2:
 159:         divd3   r4,r0,r8                #x/t
 160:         cvtdl   r8,r8                   #n=[x/t] truncated
 161:         cvtld   r8,r8                   #float(n)
 162:         subd2   r6,r4                   #t:=t-t1
 163:         muld2   r8,r4                   #n*(t-t1)
 164:         muld2   r8,r6                   #n*t1
 165:         subd2   r6,r0                   #x-n*t1
 166:         subd2   r4,r0                   #(x-n*t1)-n*(t-t1)
 167:         brb     loop
 168: E1:
 169:         movw    -4(fp),r6               #r6=nx
 170:         beql    C3                      #if nx=0 goto C3
 171:         addw2   r6,r0                   #x:=x*2**57 scale up x by nx
 172:         movw    $0,-4(fp)               #clear nx
 173:         brb     loop
 174: C3:
 175:         movq    r2,r4                   #r4 = y
 176:         subw2   $0x80,r4                #r4 = y/2
 177:         cmpd    r0,r4                   #x:y/2
 178:         blss    E2                      #if x < y/2 goto E2
 179:         bgtr    C4                      #if x > y/2 goto C4
 180:         cvtdl   r8,r8                   #ifix(float(n))
 181:         blbc    r8,E2                   #if the last bit is zero, goto E2
 182: C4:
 183:         subd2   r2,r0                   #x-y
 184: E2:
 185:         xorw2   -12(fp),r0              #x^sign (exclusive or)
 186:         movw    -8(fp),r6               #r6=nf
 187:         bicw3   $0x807f,r0,r8           #r8=exponent of x
 188:         bicw2   $0x7f80,r0              #clear the exponent of x
 189:         subw2   r6,r8                   #r8=xexp-nf
 190:         bgtr    C5                      #if xexp-nf is positive goto C5
 191:         movw    $0,r8                   #clear r8
 192:         movq    $0,r0                   #x underflow to zero
 193: C5:
 194:         bisw2   r8,r0                   #put r8 into x's exponent field
 195:         ret
 196: Rop:                                    #Reserved operand
 197:         pushl   $EDOM
 198:         calls   $1,_infnan              #generate reserved op fault
 199:         ret
 200: Ret:
 201:         movq    $0x8000,r0              #propagate reserved op
 202:         ret

Defined functions