142210Sbostic/*- 2*61289Sbostic * Copyright (c) 1990, 1993 3*61289Sbostic * The Regents of the University of California. All rights reserved. 442210Sbostic * 542210Sbostic * This code is derived from software contributed to Berkeley by 642210Sbostic * the Systems Programming Group of the University of Utah Computer 742210Sbostic * Science Department. 842210Sbostic * 942210Sbostic * %sccs.include.redist.c% 1042210Sbostic * 11*61289Sbostic * @(#)support.s 8.1 (Berkeley) 06/04/93 1242210Sbostic */ 1342210Sbostic 1442210Sbostic .text 1559660Shibler .globl _copysign, _finite, _scalb, _logb, _drem, _pow_P, _atan2__A 1642210Sbostic 1742210Sbostic| copysign(x,y) 1842210Sbostic| returns x with the sign of y. 1942210Sbostic_copysign: 2042210Sbostic movl sp@(4),d0 2142210Sbostic movl sp@(8),d1 2242210Sbostic tstw sp@(12) 2342210Sbostic jmi Lneg 2442210Sbostic bclr #31,d0 2542210Sbostic rts 2642210SbosticLneg: 2742210Sbostic bset #31,d0 2842210Sbostic rts 2942210Sbostic 3042210Sbostic| finite(x) 3142210Sbostic| returns the value TRUE if -INF < x < +INF and returns FALSE otherwise. 3242210Sbostic_finite: 3342210Sbostic movw #0x7FF0,d0 3442210Sbostic movw sp@(4),d1 3542210Sbostic andw d0,d1 3642210Sbostic cmpw d0,d1 3742210Sbostic beq Lnotfin 3842210Sbostic moveq #1,d0 3942210Sbostic rts 4042210SbosticLnotfin: 4142210Sbostic clrl d0 4242210Sbostic rts 4342210Sbostic 4442210Sbostic| scalb(x, N) 4542210Sbostic| returns x * (2**N), for integer values N. 4642210Sbostic_scalb: 4742210Sbostic fmoved sp@(4),fp0 4842210Sbostic fbeq Ldone 4942211Sbostic fscalel sp@(12),fp0 5042210SbosticLdone: 5142210Sbostic fmoved fp0,sp@- 5242210Sbostic movel sp@+,d0 5342210Sbostic movel sp@+,d1 5442210Sbostic rts 5542210Sbostic 5642210Sbostic| logb(x) 5742210Sbostic| returns the unbiased exponent of x, a signed integer in double precision, 5842210Sbostic| except that logb(0) is -INF, logb(INF) is +INF, and logb(NAN) is that NAN. 5942210Sbostic_logb: 6042210Sbostic movw sp@(4),d0 6142210Sbostic movw #0x7FF0,d1 | exponent bits 6242210Sbostic andw d1,d0 | mask off all else 6342210Sbostic cmpw d1,d0 | max exponent? 6442210Sbostic bne Lfinite | no, is finite 6542210Sbostic fmoved sp@(4),fp0 | yes, infinite or NaN 6642210Sbostic fbun Ldone | NaN returns NaN 6742210Sbostic fabsx fp0 | +-inf returns inf 6842210Sbostic jra Ldone 6942210SbosticLfinite: 7042210Sbostic fmoved sp@(4),fp0 | get entire number 7142210Sbostic fbne Lnonz | zero? 7242210Sbostic flog2x fp0 | yes, log(0) a convenient source of -inf 7342210Sbostic jra Ldone 7442210SbosticLnonz: 7542210Sbostic fgetexpx fp0 | get exponent 7642210Sbostic jra Ldone 7742210Sbostic 7842210Sbostic| drem(x,y) 7942210Sbostic| returns x REM y = x - [x/y]*y , where [x/y] is the integer nearest x/y; 8042210Sbostic| in half way case, choose the even one. 8142210Sbostic_drem: 8242210Sbostic fmoved sp@(4),fp0 8342210Sbostic fremd sp@(12),fp0 8442210Sbostic fmoved fp0,sp@- 8542210Sbostic movel sp@+,d0 8642210Sbostic movel sp@+,d1 8742210Sbostic rts 8842210Sbostic 8959660Shibler| pow_P(x,y) 9042210Sbostic| return x**y for x with sign=1 and finite y 9159660Shibler_pow_P: 9242210Sbostic flognd sp@(4),fp0 9342210Sbostic fmuld sp@(12),fp0 9442210Sbostic fetoxx fp0 9542210Sbostic fmoved fp0,sp@- 9642210Sbostic movel sp@+,d0 9742210Sbostic movel sp@+,d1 9842210Sbostic rts 9942210Sbostic 10042210Sbostic| atan2__A(y,x) 10142210Sbostic| compute atan2(y,x) where x,y are finite and non-zero 10242210Sbostic| called by atan2() after weeding out all the special cases 10342210Sbostic_atan2__A: 10442210Sbostic moveq #0,d0 | sign of result 10542210Sbostic fmoved sp@(4),fp0 | get y 10642210Sbostic fboge Lypos | <0? 10742210Sbostic moveq #1,d0 | yes, result is neg 10842210Sbostic fnegx fp0 | make y pos 10942210SbosticLypos: 11042210Sbostic fmoved sp@(12),fp1 | get x 11142210Sbostic fboge Lxpos | <0? 11242210Sbostic fnegx fp1 | yes, make x pos 11342210Sbostic fdivx fp1,fp0 | y/x 11442210Sbostic fatanx fp0,fp1 | atan(y/x) 11542210Sbostic fmovecr #0,fp0 | get pi 11642210Sbostic fsubx fp1,fp0 | pi - atan(y/x) 11742210Sbostic jra Lsetsign 11842210SbosticLxpos: 11942210Sbostic fdivx fp1,fp0 | y/x 12042210Sbostic fatanx fp0 | atan(y/x) 12142210SbosticLsetsign: 12242210Sbostic tstl d0 | should be neg? 12342210Sbostic jeq Lrpos | no, all done 12442210Sbostic fnegx fp0 | yes, negate 12542210SbosticLrpos: 12642210Sbostic fmoved fp0,sp@- 12742210Sbostic movel sp@+,d0 12842210Sbostic movel sp@+,d1 12942210Sbostic rts 130