/**************************************************************************/
/*                                                                        */
/*                                 Sources                                */
/*                                from  the                               */
/*                           XSC SOFTWARE PACKAGE                         */
/*                                                                        */
/*                Copyright (c) 1997 University of Karlsruhe              */
/*                     Institute for Appl. Mathematics                    */
/*                                                                        */
/* This program is free software for non-commercial use. For details, see */
/* the file LICENSE.XSC, distributed with this software package.          */
/*                                                                        */
/* This program is distributed WITHOUT ANY WARRANTY. For details, see the */
/* file LICENSE.XSC, distributed with this software package.              */
/*                                                                        */
/**************************************************************************/

/* RCS $Id: b_baad.c,v 1.2 1997/09/25 16:56:14 ae59 Exp $ */
/*
$Log: b_baad.c,v $
 * Revision 1.2  1997/09/25  16:56:14  ae59
 * Copyright-message
 *
 * Revision 1.1  1994/01/27  13:20:59  ae59
 * Put under RCS control
 *
 */
/************************************************************************/
/*                                                                      */
/* Descriptive Name : b_baad.c          Processor : C                   */
/*                                                                      */
/* Addition of absolute values of intern numbers                        */
/* abs(first number) > abs(second number) > 0                           */
/*                                                                      */
/* Function value : int     0 - absolute value of intern numbers added  */
/*                      OFLOW - exponent overflow                       */
/*                      ALLOC - allocation error                        */
/*                                                                      */
/* Rounding : towards zero                                              */
/*                                                                      */
/*      Date            : 1991-09-09                            */
/*      1991-09-09 : reduce maximum line length                 */
/*      1990-11-22 : reduce length if trailing zero mantissa    */
/*      1990-08-02 : explicit compare                           */
/*                   assignment to bitfield with cast           */
/************************************************************************/

#ifndef ALL_IN_ONE
#ifdef AIX
#include "/u/p88c/runtime/o_defs.h"
#else
#include "o_defs.h"
#endif
#define local
extern a_btyp b_maxl;
#endif

#ifdef LINT_ARGS
local int b_baad(multiprecision i1,multiprecision i2,multiprecision r)
#else
local int b_baad(i1,i2,r)

multiprecision i1;
multiprecision i2;      /* pointer to intern variables          */
multiprecision r;       /* pointer to result variable           */
#endif
        {
        a_intg k;       /* loop variable                         */
        a_intg l;       /* length of significant second mantissa */
        a_intg m;       /* length of resultant mantissa          */
        a_intg cv;      /* exponent difference                   */
        a_intg carry;   /* carry from choped addition            */
        a_intg rr;      /* non-zero mantissa                     */
        a_btyp *s;      /* pointer to result mantissa            */
/*---------------------------------------------------------------*/
        r->z = 0;       /* result is non-zero                    */
/*---------------------------------------------------------------*/
        cv = i1->e-i2->e;
                        /* exponent difference                   */
/*---------------------------------------------------------------*/
        l = cv+i2->l;   /* intermediate value                    */
/*---------------------------------------------------------------*/
        if (i1->l>=b_maxl) m = b_maxl;
        else if (l>=b_maxl) m = b_maxl;
        else if (i1->l>l) m = i1->l+1;
        else m = l+1;
                        /* resultant length of mantissa          */
/*---------------------------------------------------------------*/
        if (b_ball(m,&s)) return(ALLOC);
                        /* allocate and clear result mantissa    */
/*---------------------------------------------------------------*/
        B_COPY(s,i1->m,(i1->l>m)?m:i1->l)
                        /* copy mantissa of first operand to result     */
/*----------------------------------------------------------------------*/
        r->e = i1->e;   /* copy exponent of i1 to r                     */
/*----------------------------------------------------------------------*/
        if (cv>=m)      /* exponents differ by at least m               */
                        /* mantissas do not overlap                     */
           if (i1->l<=cv)
              r->r = 1; /* second mantissa is non-zero                  */
           else         /* mantissas overlap                            */
              {
              if (b_bmat((i1->l<l)?
                         i1->l-cv:
                         i2->l,&i1->m[cv],i2->m,0,&rr))
                 if (b_bcat(cv-m,&i1->m[m]))
                    {
                    if (b_bcad(m,s))
                       {
                       for (k=m-1;k>0;k--) *(s+k) = 0;
                       *s = 1;
                       if (r->e==MAXINT) return(OFLOW);
                       r->e++;
                       }
                    if (!rr)
                    rr = (i1->l<l) ? b_bmts(l-i1->l,&i2->m[i1->l])
                                   : b_bmts(i1->l-l,&i1->m[l]);
                    }
                 else rr = 1;
              else rr = 1;
              r->r = (unsigned int)rr;
              }
        else
           {
                        /* test choped digits of operands       */
           if (i1->l<=m)
              {
              r->r = b_bmts(l-m,&i2->m[m-cv]);
              carry = 0;
              }
           else
              {
                        /* determine carry from overlapping part */
              if (i1->l<l) {
                 carry = b_bmat(i1->l-m,&i1->m[m],&i2->m[m],0,&rr);
                 if ((r->r = (unsigned int)rr)==0)
                    r->r = b_bmts(l-i1->l,&i2->m[i1->l]);
                 }
              else {
                 carry = b_bmat(l-m,&i1->m[m],&i2->m[m],0,&rr);
                 if ((r->r = (unsigned int)rr)==0)
                    r->r = b_bmts(i1->l-l,&i1->m[l]);
                 }
              if (carry)
                 carry = b_bcad(m,s);
              }

           if (b_addm((l>m)?m-cv:i2->l,s+cv,i2->m))
           if (b_bcad(cv,s) || carry)
              {
              if (*(s+m-1)) r->r = 1;
              for (k=m-1;k>0;k--) *(s+k) = *(s+k-1);
              *s = 1;
              if (r->e==MAXINT) return(OFLOW);
              r->e++;
              }
           }
/*--------------------------------------------------------------*/
        if (r->l)
           {
#ifdef HEAP_CHECK
b_freh((a_char *)&r->m,(a_char *)r->m,(a_char *)"b_baad");
#endif
           B_FREE(r->m)
           }
        r->l = m;
        r->m = s;
/*--------------------------------------------------------------*/
        while (s[r->l-1]==ZERO) r->l--;
                        /* remove trailing zeros by reducing r->l */
/*--------------------------------------------------------------*/
        return(0);
        }
