1*42210Sbostic/*- 2*42210Sbostic * Copyright (c) 1990 The Regents of the University of California. 3*42210Sbostic * All rights reserved. 4*42210Sbostic * 5*42210Sbostic * This code is derived from software contributed to Berkeley by 6*42210Sbostic * the Systems Programming Group of the University of Utah Computer 7*42210Sbostic * Science Department. 8*42210Sbostic * 9*42210Sbostic * %sccs.include.redist.c% 10*42210Sbostic * 11*42210Sbostic * @(#)support.s 5.1 (Berkeley) 05/17/90 12*42210Sbostic */ 13*42210Sbostic 14*42210Sbostic .text 15*42210Sbostic .globl _copysign, _finite, _scalb, _logb, _drem, _pow_p, _atan2__A 16*42210Sbostic 17*42210Sbostic| copysign(x,y) 18*42210Sbostic| returns x with the sign of y. 19*42210Sbostic_copysign: 20*42210Sbostic movl sp@(4),d0 21*42210Sbostic movl sp@(8),d1 22*42210Sbostic tstw sp@(12) 23*42210Sbostic jmi Lneg 24*42210Sbostic bclr #31,d0 25*42210Sbostic rts 26*42210SbosticLneg: 27*42210Sbostic bset #31,d0 28*42210Sbostic rts 29*42210Sbostic 30*42210Sbostic| finite(x) 31*42210Sbostic| returns the value TRUE if -INF < x < +INF and returns FALSE otherwise. 32*42210Sbostic_finite: 33*42210Sbostic movw #0x7FF0,d0 34*42210Sbostic movw sp@(4),d1 35*42210Sbostic andw d0,d1 36*42210Sbostic cmpw d0,d1 37*42210Sbostic beq Lnotfin 38*42210Sbostic moveq #1,d0 39*42210Sbostic rts 40*42210SbosticLnotfin: 41*42210Sbostic clrl d0 42*42210Sbostic rts 43*42210Sbostic 44*42210Sbostic| scalb(x, N) 45*42210Sbostic| returns x * (2**N), for integer values N. 46*42210Sbostic_scalb: 47*42210Sbostic fmoved sp@(4),fp0 48*42210Sbostic fbeq Ldone 49*42210Sbostic ftwotoxl sp@(12),fp1 50*42210Sbostic fmoved fp1,sp@- 51*42210Sbostic fmuld sp@+,fp0 52*42210SbosticLdone: 53*42210Sbostic fmoved fp0,sp@- 54*42210Sbostic movel sp@+,d0 55*42210Sbostic movel sp@+,d1 56*42210Sbostic rts 57*42210Sbostic 58*42210Sbostic| logb(x) 59*42210Sbostic| returns the unbiased exponent of x, a signed integer in double precision, 60*42210Sbostic| except that logb(0) is -INF, logb(INF) is +INF, and logb(NAN) is that NAN. 61*42210Sbostic_logb: 62*42210Sbostic movw sp@(4),d0 63*42210Sbostic movw #0x7FF0,d1 | exponent bits 64*42210Sbostic andw d1,d0 | mask off all else 65*42210Sbostic cmpw d1,d0 | max exponent? 66*42210Sbostic bne Lfinite | no, is finite 67*42210Sbostic fmoved sp@(4),fp0 | yes, infinite or NaN 68*42210Sbostic fbun Ldone | NaN returns NaN 69*42210Sbostic fabsx fp0 | +-inf returns inf 70*42210Sbostic jra Ldone 71*42210SbosticLfinite: 72*42210Sbostic fmoved sp@(4),fp0 | get entire number 73*42210Sbostic fbne Lnonz | zero? 74*42210Sbostic flog2x fp0 | yes, log(0) a convenient source of -inf 75*42210Sbostic jra Ldone 76*42210SbosticLnonz: 77*42210Sbostic fgetexpx fp0 | get exponent 78*42210Sbostic jra Ldone 79*42210Sbostic 80*42210Sbostic| drem(x,y) 81*42210Sbostic| returns x REM y = x - [x/y]*y , where [x/y] is the integer nearest x/y; 82*42210Sbostic| in half way case, choose the even one. 83*42210Sbostic_drem: 84*42210Sbostic fmoved sp@(4),fp0 85*42210Sbostic fremd sp@(12),fp0 86*42210Sbostic fmoved fp0,sp@- 87*42210Sbostic movel sp@+,d0 88*42210Sbostic movel sp@+,d1 89*42210Sbostic rts 90*42210Sbostic 91*42210Sbostic| pow_p(x,y) 92*42210Sbostic| return x**y for x with sign=1 and finite y 93*42210Sbostic_pow_p: 94*42210Sbostic flognd sp@(4),fp0 95*42210Sbostic fmuld sp@(12),fp0 96*42210Sbostic fetoxx fp0 97*42210Sbostic fmoved fp0,sp@- 98*42210Sbostic movel sp@+,d0 99*42210Sbostic movel sp@+,d1 100*42210Sbostic rts 101*42210Sbostic 102*42210Sbostic| atan2__A(y,x) 103*42210Sbostic| compute atan2(y,x) where x,y are finite and non-zero 104*42210Sbostic| called by atan2() after weeding out all the special cases 105*42210Sbostic_atan2__A: 106*42210Sbostic moveq #0,d0 | sign of result 107*42210Sbostic fmoved sp@(4),fp0 | get y 108*42210Sbostic fboge Lypos | <0? 109*42210Sbostic moveq #1,d0 | yes, result is neg 110*42210Sbostic fnegx fp0 | make y pos 111*42210SbosticLypos: 112*42210Sbostic fmoved sp@(12),fp1 | get x 113*42210Sbostic fboge Lxpos | <0? 114*42210Sbostic fnegx fp1 | yes, make x pos 115*42210Sbostic fdivx fp1,fp0 | y/x 116*42210Sbostic fatanx fp0,fp1 | atan(y/x) 117*42210Sbostic fmovecr #0,fp0 | get pi 118*42210Sbostic fsubx fp1,fp0 | pi - atan(y/x) 119*42210Sbostic jra Lsetsign 120*42210SbosticLxpos: 121*42210Sbostic fdivx fp1,fp0 | y/x 122*42210Sbostic fatanx fp0 | atan(y/x) 123*42210SbosticLsetsign: 124*42210Sbostic tstl d0 | should be neg? 125*42210Sbostic jeq Lrpos | no, all done 126*42210Sbostic fnegx fp0 | yes, negate 127*42210SbosticLrpos: 128*42210Sbostic fmoved fp0,sp@- 129*42210Sbostic movel sp@+,d0 130*42210Sbostic movel sp@+,d1 131*42210Sbostic rts 132