|
|
1.1 ! root 1: /*- ! 2: * Copyright (c) 1990 The Regents of the University of California. ! 3: * All rights reserved. ! 4: * ! 5: * This code is derived from software contributed to Berkeley by ! 6: * the Systems Programming Group of the University of Utah Computer ! 7: * Science Department. ! 8: * ! 9: * Redistribution and use in source and binary forms are permitted ! 10: * provided that: (1) source distributions retain this entire copyright ! 11: * notice and comment, and (2) distributions including binaries display ! 12: * the following acknowledgement: ``This product includes software ! 13: * developed by the University of California, Berkeley and its contributors'' ! 14: * in the documentation or other materials provided with the distribution ! 15: * and in all advertising materials mentioning features or use of this ! 16: * software. Neither the name of the University nor the names of its ! 17: * contributors may be used to endorse or promote products derived ! 18: * from this software without specific prior written permission. ! 19: * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR ! 20: * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED ! 21: * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. ! 22: * ! 23: * @(#)support.s 5.2 (Berkeley) 5/17/90 ! 24: */ ! 25: ! 26: .text ! 27: .globl _copysign, _finite, _scalb, _logb, _drem, _pow_p, _atan2__A ! 28: ! 29: | copysign(x,y) ! 30: | returns x with the sign of y. ! 31: _copysign: ! 32: movl sp@(4),d0 ! 33: movl sp@(8),d1 ! 34: tstw sp@(12) ! 35: jmi Lneg ! 36: bclr #31,d0 ! 37: rts ! 38: Lneg: ! 39: bset #31,d0 ! 40: rts ! 41: ! 42: | finite(x) ! 43: | returns the value TRUE if -INF < x < +INF and returns FALSE otherwise. ! 44: _finite: ! 45: movw #0x7FF0,d0 ! 46: movw sp@(4),d1 ! 47: andw d0,d1 ! 48: cmpw d0,d1 ! 49: beq Lnotfin ! 50: moveq #1,d0 ! 51: rts ! 52: Lnotfin: ! 53: clrl d0 ! 54: rts ! 55: ! 56: | scalb(x, N) ! 57: | returns x * (2**N), for integer values N. ! 58: _scalb: ! 59: fmoved sp@(4),fp0 ! 60: fbeq Ldone ! 61: fscalel sp@(12),fp0 ! 62: Ldone: ! 63: fmoved fp0,sp@- ! 64: movel sp@+,d0 ! 65: movel sp@+,d1 ! 66: rts ! 67: ! 68: | logb(x) ! 69: | returns the unbiased exponent of x, a signed integer in double precision, ! 70: | except that logb(0) is -INF, logb(INF) is +INF, and logb(NAN) is that NAN. ! 71: _logb: ! 72: movw sp@(4),d0 ! 73: movw #0x7FF0,d1 | exponent bits ! 74: andw d1,d0 | mask off all else ! 75: cmpw d1,d0 | max exponent? ! 76: bne Lfinite | no, is finite ! 77: fmoved sp@(4),fp0 | yes, infinite or NaN ! 78: fbun Ldone | NaN returns NaN ! 79: fabsx fp0 | +-inf returns inf ! 80: jra Ldone ! 81: Lfinite: ! 82: fmoved sp@(4),fp0 | get entire number ! 83: fbne Lnonz | zero? ! 84: flog2x fp0 | yes, log(0) a convenient source of -inf ! 85: jra Ldone ! 86: Lnonz: ! 87: fgetexpx fp0 | get exponent ! 88: jra Ldone ! 89: ! 90: | drem(x,y) ! 91: | returns x REM y = x - [x/y]*y , where [x/y] is the integer nearest x/y; ! 92: | in half way case, choose the even one. ! 93: _drem: ! 94: fmoved sp@(4),fp0 ! 95: fremd sp@(12),fp0 ! 96: fmoved fp0,sp@- ! 97: movel sp@+,d0 ! 98: movel sp@+,d1 ! 99: rts ! 100: ! 101: | pow_p(x,y) ! 102: | return x**y for x with sign=1 and finite y ! 103: _pow_p: ! 104: flognd sp@(4),fp0 ! 105: fmuld sp@(12),fp0 ! 106: fetoxx fp0 ! 107: fmoved fp0,sp@- ! 108: movel sp@+,d0 ! 109: movel sp@+,d1 ! 110: rts ! 111: ! 112: | atan2__A(y,x) ! 113: | compute atan2(y,x) where x,y are finite and non-zero ! 114: | called by atan2() after weeding out all the special cases ! 115: _atan2__A: ! 116: moveq #0,d0 | sign of result ! 117: fmoved sp@(4),fp0 | get y ! 118: fboge Lypos | <0? ! 119: moveq #1,d0 | yes, result is neg ! 120: fnegx fp0 | make y pos ! 121: Lypos: ! 122: fmoved sp@(12),fp1 | get x ! 123: fboge Lxpos | <0? ! 124: fnegx fp1 | yes, make x pos ! 125: fdivx fp1,fp0 | y/x ! 126: fatanx fp0,fp1 | atan(y/x) ! 127: fmovecr #0,fp0 | get pi ! 128: fsubx fp1,fp0 | pi - atan(y/x) ! 129: jra Lsetsign ! 130: Lxpos: ! 131: fdivx fp1,fp0 | y/x ! 132: fatanx fp0 | atan(y/x) ! 133: Lsetsign: ! 134: tstl d0 | should be neg? ! 135: jeq Lrpos | no, all done ! 136: fnegx fp0 | yes, negate ! 137: Lrpos: ! 138: fmoved fp0,sp@- ! 139: movel sp@+,d0 ! 140: movel sp@+,d1 ! 141: rts
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.