1*0a6a1f1dSLionel Sambuc/* $NetBSD: n_support.S,v 1.10 2014/11/14 14:53:17 joerg Exp $ */ 284d9c625SLionel Sambuc/* 384d9c625SLionel Sambuc * Copyright (c) 1985, 1993 484d9c625SLionel Sambuc * The Regents of the University of California. All rights reserved. 584d9c625SLionel Sambuc * 684d9c625SLionel Sambuc * Redistribution and use in source and binary forms, with or without 784d9c625SLionel Sambuc * modification, are permitted provided that the following conditions 884d9c625SLionel Sambuc * are met: 984d9c625SLionel Sambuc * 1. Redistributions of source code must retain the above copyright 1084d9c625SLionel Sambuc * notice, this list of conditions and the following disclaimer. 1184d9c625SLionel Sambuc * 2. Redistributions in binary form must reproduce the above copyright 1284d9c625SLionel Sambuc * notice, this list of conditions and the following disclaimer in the 1384d9c625SLionel Sambuc * documentation and/or other materials provided with the distribution. 1484d9c625SLionel Sambuc * 3. Neither the name of the University nor the names of its contributors 1584d9c625SLionel Sambuc * may be used to endorse or promote products derived from this software 1684d9c625SLionel Sambuc * without specific prior written permission. 1784d9c625SLionel Sambuc * 1884d9c625SLionel Sambuc * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 1984d9c625SLionel Sambuc * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 2084d9c625SLionel Sambuc * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 2184d9c625SLionel Sambuc * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE 2284d9c625SLionel Sambuc * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 2384d9c625SLionel Sambuc * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 2484d9c625SLionel Sambuc * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 2584d9c625SLionel Sambuc * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 2684d9c625SLionel Sambuc * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 2784d9c625SLionel Sambuc * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 2884d9c625SLionel Sambuc * SUCH DAMAGE. 2984d9c625SLionel Sambuc * 3084d9c625SLionel Sambuc * @(#)support.s 8.1 (Berkeley) 6/4/93 3184d9c625SLionel Sambuc */ 3284d9c625SLionel Sambuc#include <machine/asm.h> 3384d9c625SLionel Sambuc 34*0a6a1f1dSLionel SambucWEAK_ALIAS(logbl,logb) 35*0a6a1f1dSLionel SambucWEAK_ALIAS(copysignl, _copysignl) 36*0a6a1f1dSLionel SambucWEAK_ALIAS(_copysignl, copysign) 37*0a6a1f1dSLionel Sambuc 3884d9c625SLionel Sambuc .text 3984d9c625SLionel Sambuc_sccsid: 4084d9c625SLionel Sambuc .asciz "@(#)support.s\t1.3 (Berkeley) 8/21/85; 8.1 (ucb.elefunt) 6/4/93" 4184d9c625SLionel Sambuc 4284d9c625SLionel Sambuc/* 4384d9c625SLionel Sambuc * copysign(x,y), 4484d9c625SLionel Sambuc * logb(x), 4584d9c625SLionel Sambuc * scalb(x,N), 4684d9c625SLionel Sambuc * finite(x), 4784d9c625SLionel Sambuc * drem(x,y), 4884d9c625SLionel Sambuc * Coded in vax assembly language by K.C. Ng, 3/14/85. 4984d9c625SLionel Sambuc * Revised by K.C. Ng on 4/9/85. 5084d9c625SLionel Sambuc */ 5184d9c625SLionel Sambuc 5284d9c625SLionel Sambuc/* 5384d9c625SLionel Sambuc * double copysign(double x,double y) 5484d9c625SLionel Sambuc */ 5584d9c625SLionel Sambuc 5684d9c625SLionel SambucENTRY(copysign, 0) 5784d9c625SLionel Sambuc movq 4(%ap),%r0 # load x into %r0 5884d9c625SLionel Sambuc bicw3 $0x807f,%r0,%r2 # mask off the exponent of x 5984d9c625SLionel Sambuc beql Lz # if zero or reserved op then return x 6084d9c625SLionel Sambuc bicw3 $0x7fff,12(%ap),%r2 # copy the sign bit of y into %r2 6184d9c625SLionel Sambuc bicw2 $0x8000,%r0 # replace x by |x| 6284d9c625SLionel Sambuc bisw2 %r2,%r0 # copy the sign bit of y to x 6384d9c625SLionel SambucLz: ret 6484d9c625SLionel Sambuc 65*0a6a1f1dSLionel SambucENTRY(copysignf, 0) 66*0a6a1f1dSLionel Sambuc movl 4(%ap),%r0 # load x into %r0 67*0a6a1f1dSLionel Sambuc bicw3 $0x807f,%r0,%r2 # mask off the exponent of x 68*0a6a1f1dSLionel Sambuc beql 1f # if zero or reserved op then return x 69*0a6a1f1dSLionel Sambuc bicw3 $0x7fff,8(%ap),%r2 # copy the sign bit of y into %r2 70*0a6a1f1dSLionel Sambuc bicw2 $0x8000,%r0 # replace x by |x| 71*0a6a1f1dSLionel Sambuc bisw2 %r2,%r0 # copy the sign bit of y to x 72*0a6a1f1dSLionel Sambuc1: ret 73*0a6a1f1dSLionel Sambuc 74*0a6a1f1dSLionel Sambuc/* 75*0a6a1f1dSLionel Sambuc * float logbf(float x); 76*0a6a1f1dSLionel Sambuc */ 77*0a6a1f1dSLionel SambucENTRY(logbf, 0) 78*0a6a1f1dSLionel Sambuc cvtfd 4(%ap),-(%sp) 79*0a6a1f1dSLionel Sambuc calls $2,_C_LABEL(logb) 80*0a6a1f1dSLionel Sambuc cvtdf %r0,%r0 81*0a6a1f1dSLionel Sambuc ret 82*0a6a1f1dSLionel Sambuc 8384d9c625SLionel Sambuc/* 8484d9c625SLionel Sambuc * double logb(double x); 8584d9c625SLionel Sambuc */ 8684d9c625SLionel SambucENTRY(logb, 0) 8784d9c625SLionel Sambuc bicl3 $0xffff807f,4(%ap),%r0 # mask off the exponent of x 8884d9c625SLionel Sambuc beql Ln 8984d9c625SLionel Sambuc ashl $-7,%r0,%r0 # get the bias exponent 9084d9c625SLionel Sambuc subl2 $129,%r0 # get the unbias exponent 9184d9c625SLionel Sambuc cvtld %r0,%r0 # return the answer in double 9284d9c625SLionel Sambuc ret 9384d9c625SLionel SambucLn: movq 4(%ap),%r0 # %r0:1 = x (zero or reserved op) 9484d9c625SLionel Sambuc bneq 1f # simply return if reserved op 9584d9c625SLionel Sambuc movq $0x0000fe00ffffcfff,%r0 # -2147483647.0 9684d9c625SLionel Sambuc1: ret 9784d9c625SLionel Sambuc 9884d9c625SLionel Sambuc/* 9984d9c625SLionel Sambuc * long finite(double x); 10084d9c625SLionel Sambuc */ 10184d9c625SLionel Sambuc#ifndef __GFLOAT__ 10284d9c625SLionel Sambuc .globl finitef 10384d9c625SLionel Sambucfinitef = finite 10484d9c625SLionel Sambuc#endif 10584d9c625SLionel SambucENTRY(finite, 0) 10684d9c625SLionel Sambuc bicw3 $0x7f,4(%ap),%r0 # mask off the mantissa 10784d9c625SLionel Sambuc cmpw %r0,$0x8000 # to see if x is the reserved op 10884d9c625SLionel Sambuc beql 1f # if so, return FALSE (0) 10984d9c625SLionel Sambuc movl $1,%r0 # else return TRUE (1) 11084d9c625SLionel Sambuc ret 11184d9c625SLionel Sambuc1: clrl %r0 11284d9c625SLionel Sambuc ret 11384d9c625SLionel Sambuc 11484d9c625SLionel Sambuc/* int isnan(double x); 11584d9c625SLionel Sambuc */ 11684d9c625SLionel Sambuc#if 0 11784d9c625SLionel SambucENTRY(isnan, 0) 11884d9c625SLionel Sambuc clrl %r0 11984d9c625SLionel Sambuc ret 12084d9c625SLionel Sambuc#endif 12184d9c625SLionel Sambuc 12284d9c625SLionel Sambuc/* int isnanf(float x); 12384d9c625SLionel Sambuc */ 12484d9c625SLionel SambucENTRY(isnanf, 0) 12584d9c625SLionel Sambuc clrl %r0 12684d9c625SLionel Sambuc ret 12784d9c625SLionel Sambuc 12884d9c625SLionel Sambuc/* 12984d9c625SLionel Sambuc * double scalb(x,N) 13084d9c625SLionel Sambuc * double x; double N; 13184d9c625SLionel Sambuc */ 13284d9c625SLionel Sambuc .set ERANGE,34 13384d9c625SLionel Sambuc 13484d9c625SLionel SambucENTRY(scalb, 0) 13584d9c625SLionel Sambuc movq 4(%ap),%r0 13684d9c625SLionel Sambuc bicl3 $0xffff807f,%r0,%r3 13784d9c625SLionel Sambuc beql ret1 # 0 or reserved operand 13884d9c625SLionel Sambuc movq 12(%ap),%r4 13984d9c625SLionel Sambuc cvtdl %r4, %r2 14084d9c625SLionel Sambuc cmpl %r2,$0x12c 14184d9c625SLionel Sambuc bgeq ovfl 14284d9c625SLionel Sambuc cmpl %r2,$-0x12c 14384d9c625SLionel Sambuc bleq unfl 14484d9c625SLionel Sambuc ashl $7,%r2,%r2 14584d9c625SLionel Sambuc addl2 %r2,%r3 14684d9c625SLionel Sambuc bleq unfl 14784d9c625SLionel Sambuc cmpl %r3,$0x8000 14884d9c625SLionel Sambuc bgeq ovfl 14984d9c625SLionel Sambuc addl2 %r2,%r0 15084d9c625SLionel Sambuc ret 15184d9c625SLionel Sambucovfl: pushl $ERANGE 15284d9c625SLionel Sambuc calls $1,_C_LABEL(infnan) # if it returns 15384d9c625SLionel Sambuc bicw3 $0x7fff,4(%ap),%r2 # get the sign of input arg 15484d9c625SLionel Sambuc bisw2 %r2,%r0 # re-attach the sign to %r0/1 15584d9c625SLionel Sambuc ret 15684d9c625SLionel Sambucunfl: movq $0,%r0 15784d9c625SLionel Sambucret1: ret 15884d9c625SLionel Sambuc 15984d9c625SLionel Sambuc/* 16084d9c625SLionel Sambuc * DREM(X,Y) 16184d9c625SLionel Sambuc * RETURN X REM Y =X-N*Y, N=[X/Y] ROUNDED (ROUNDED TO EVEN IN THE HALF WAY CASE) 16284d9c625SLionel Sambuc * DOUBLE PRECISION (VAX D format 56 bits) 16384d9c625SLionel Sambuc * CODED IN VAX ASSEMBLY LANGUAGE BY K.C. NG, 4/8/85. 16484d9c625SLionel Sambuc */ 16584d9c625SLionel Sambuc .set EDOM,33 16684d9c625SLionel Sambuc 16784d9c625SLionel SambucENTRY(drem, 0x0fc0) 16884d9c625SLionel Sambuc subl2 $12,%sp 16984d9c625SLionel Sambuc movq 4(%ap),%r0 #%r0=x 17084d9c625SLionel Sambuc movq 12(%ap),%r2 #%r2=y 17184d9c625SLionel Sambuc jeql Rop #if y=0 then generate reserved op fault 17284d9c625SLionel Sambuc bicw3 $0x007f,%r0,%r4 #check if x is Rop 17384d9c625SLionel Sambuc cmpw %r4,$0x8000 17484d9c625SLionel Sambuc jeql Ret #if x is Rop then return Rop 17584d9c625SLionel Sambuc bicl3 $0x007f,%r2,%r4 #check if y is Rop 17684d9c625SLionel Sambuc cmpw %r4,$0x8000 17784d9c625SLionel Sambuc jeql Ret #if y is Rop then return Rop 17884d9c625SLionel Sambuc bicw2 $0x8000,%r2 #y := |y| 17984d9c625SLionel Sambuc movw $0,-4(%fp) #-4(%fp) = nx := 0 18084d9c625SLionel Sambuc cmpw %r2,$0x1c80 #yexp ? 57 18184d9c625SLionel Sambuc bgtr C1 #if yexp > 57 goto C1 18284d9c625SLionel Sambuc addw2 $0x1c80,%r2 #scale up y by 2**57 18384d9c625SLionel Sambuc movw $0x1c80,-4(%fp) #nx := 57 (exponent field) 18484d9c625SLionel SambucC1: 18584d9c625SLionel Sambuc movw -4(%fp),-8(%fp) #-8(%fp) = nf := nx 18684d9c625SLionel Sambuc bicw3 $0x7fff,%r0,-12(%fp) #-12(%fp) = sign of x 18784d9c625SLionel Sambuc bicw2 $0x8000,%r0 #x := |x| 18884d9c625SLionel Sambuc movq %r2,%r10 #y1 := y 18984d9c625SLionel Sambuc bicl2 $0xffff07ff,%r11 #clear the last 27 bits of y1 19084d9c625SLionel Sambucloop: 19184d9c625SLionel Sambuc cmpd %r0,%r2 #x ? y 19284d9c625SLionel Sambuc bleq E1 #if x <= y goto E1 19384d9c625SLionel Sambuc /* begin argument reduction */ 19484d9c625SLionel Sambuc movq %r2,%r4 #t =y 19584d9c625SLionel Sambuc movq %r10,%r6 #t1=y1 19684d9c625SLionel Sambuc bicw3 $0x807f,%r0,%r8 #xexp= exponent of x 19784d9c625SLionel Sambuc bicw3 $0x807f,%r2,%r9 #yexp= exponent fo y 19884d9c625SLionel Sambuc subw2 %r9,%r8 #xexp-yexp 19984d9c625SLionel Sambuc subw2 $0x0c80,%r8 #k=xexp-yexp-25(exponent bit field) 20084d9c625SLionel Sambuc blss C2 #if k<0 goto C2 20184d9c625SLionel Sambuc addw2 %r8,%r4 #t +=k 20284d9c625SLionel Sambuc addw2 %r8,%r6 #t1+=k, scale up t and t1 20384d9c625SLionel SambucC2: 20484d9c625SLionel Sambuc divd3 %r4,%r0,%r8 #x/t 20584d9c625SLionel Sambuc cvtdl %r8,%r8 #n=[x/t] truncated 20684d9c625SLionel Sambuc cvtld %r8,%r8 #float(n) 20784d9c625SLionel Sambuc subd2 %r6,%r4 #t:=t-t1 20884d9c625SLionel Sambuc muld2 %r8,%r4 #n*(t-t1) 20984d9c625SLionel Sambuc muld2 %r8,%r6 #n*t1 21084d9c625SLionel Sambuc subd2 %r6,%r0 #x-n*t1 21184d9c625SLionel Sambuc subd2 %r4,%r0 #(x-n*t1)-n*(t-t1) 21284d9c625SLionel Sambuc jbr loop 21384d9c625SLionel SambucE1: 21484d9c625SLionel Sambuc movw -4(%fp),%r6 #%r6=nx 21584d9c625SLionel Sambuc beql C3 #if nx=0 goto C3 21684d9c625SLionel Sambuc addw2 %r6,%r0 #x:=x*2**57 scale up x by nx 21784d9c625SLionel Sambuc movw $0,-4(%fp) #clear nx 21884d9c625SLionel Sambuc jbr loop 21984d9c625SLionel SambucC3: 22084d9c625SLionel Sambuc movq %r2,%r4 #%r4 = y 22184d9c625SLionel Sambuc subw2 $0x80,%r4 #%r4 = y/2 22284d9c625SLionel Sambuc cmpd %r0,%r4 #x:y/2 22384d9c625SLionel Sambuc blss E2 #if x < y/2 goto E2 22484d9c625SLionel Sambuc bgtr C4 #if x > y/2 goto C4 22584d9c625SLionel Sambuc cvtdl %r8,%r8 #ifix(float(n)) 22684d9c625SLionel Sambuc blbc %r8,E2 #if the last bit is zero, goto E2 22784d9c625SLionel SambucC4: 22884d9c625SLionel Sambuc subd2 %r2,%r0 #x-y 22984d9c625SLionel SambucE2: 23084d9c625SLionel Sambuc xorw2 -12(%fp),%r0 #x^sign (exclusive or) 23184d9c625SLionel Sambuc movw -8(%fp),%r6 #%r6=nf 23284d9c625SLionel Sambuc bicw3 $0x807f,%r0,%r8 #%r8=exponent of x 23384d9c625SLionel Sambuc bicw2 $0x7f80,%r0 #clear the exponent of x 23484d9c625SLionel Sambuc subw2 %r6,%r8 #%r8=xexp-nf 23584d9c625SLionel Sambuc bgtr C5 #if xexp-nf is positive goto C5 23684d9c625SLionel Sambuc movw $0,%r8 #clear %r8 23784d9c625SLionel Sambuc movq $0,%r0 #x underflow to zero 23884d9c625SLionel SambucC5: 23984d9c625SLionel Sambuc bisw2 %r8,%r0 /* put %r8 into x's exponent field */ 24084d9c625SLionel Sambuc ret 24184d9c625SLionel SambucRop: #Reserved operand 24284d9c625SLionel Sambuc pushl $EDOM 24384d9c625SLionel Sambuc calls $1,_C_LABEL(infnan) #generate reserved op fault 24484d9c625SLionel Sambuc ret 24584d9c625SLionel SambucRet: 24684d9c625SLionel Sambuc movq $0x8000,%r0 #propagate reserved op 24784d9c625SLionel Sambuc ret 248