/**************************************************************************/
/*                                                                        */
/*                                 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: l_read.c,v 1.2 1997/09/25 17:38:04 ae59 Exp $ */
/*
$Log: l_read.c,v $
 * Revision 1.2  1997/09/25  17:38:04  ae59
 * Copyright-message
 *
 * Revision 1.1  1994/01/27  13:23:27  ae59
 * Put under RCS control
 *
 */
/****************************************************************/
/*                                                              */
/*      Filename        : l_read.c                              */
/*                                                              */
/*      Entries         : void l_read(device,s,rnd,ii)          */
/*                        FILE *device;                         */
/*                        multiprecision *s;                    */
/*                        a_intg rnd;                           */
/*                        a_intg ii;                            */
/*                                                              */
/*      Arguments       : device - input device reading string  */
/*                        s - resultant multiprecision value    */
/*                        rnd - rounding mode                   */
/*                              -1 = rounding downwards         */
/*                               0 = round to nearest           */
/*                               1 = round upwards              */
/*                        ii - first input character            */
/*                                                              */
/*      Description     : Read a character string from input    */
/*                        device and convert to multiprecision  */
/*                                                              */
/*      Note            : Length of input string is restricted  */
/*                        by BUFFERSIZE.                        */
/*                                                              */
/*      Date            : 1992-07-22                            */
/*      1992-07-22 : cast to size_t in malloc =b=               */
/*      1991-11-22 : set rounding bit if inexact conversion     */
/*      1991-03-14 : error text displayed in all trap calls     */
/*      1991-02-18 : b_scan(),b_coni(),b_conf() new arguments   */
/*                   b_adpp() used                              */
/*      1990-11-16 : E_TPUSH+E_TPOPP                            */
/*      1990-08-06 : explicit compare/(int)cast for arg ii      */
/*      1990-07-12 : LINT_ARGS prototype, Maxl,cm,cp renamed    */
/****************************************************************/

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

#ifdef LINT_ARGS
local void l_read(FILE *device,multiprecision *s,a_intg rnd,a_intg ii)
#else
local void l_read(device,s,rnd,ii)

FILE *device;
multiprecision *s;
a_intg rnd;
a_intg ii;
#endif
        {
        a_intg bits,dp,expo,length;
        a_intg p_dp,p_length,res_length;
        a_intg a_b,a_e,i,k,size,offset;
        a_bool sign;
        a_btyp *res;
        char *buffer;

        E_TPUSH("l_read")

        buffer = (char *)b_cp__;
        size = BUFFERSIZE;

        /* scan digits from device and store decimal value in buffer */
        switch (b_scan(device,&buffer,&size,&expo,&dp,&length,&sign,(int)ii))
           {
           case  1: e_trap(ALLOCATION,2,E_TMSG,56);
                    E_TPOPP("l_read")
                    return;
           case  2:
           case  3:
           case  4: e_trap(I_O_ERROR,2,E_TMSG,58);
                    E_TPOPP("l_read")
                    return;
           case  5: e_trap(NO_ERROR+E_EMSG+E_ECNT,2,E_TMSG,64);
           default: ;
           }

        /* number is zero                                       */
        if (dp==0 && length==0)
           {
           (*s)->z = TRUE;
           (*s)->r = 0;
           E_TPOPP("l_read")
           return;
           }

        /* initialize data                                      */
        (*s)->s = sign;
        (*s)->z = FALSE;

        /* adjust and pack decimal digits */
        /* k = index of start of packed mantissa */
        if (b_adpp((a_btyp **)&buffer,&size,
                   expo,dp,length,&k,&p_dp,&p_length))
           {
           e_trap(ALLOCATION,2,E_TMSG,56);
           E_TPOPP("l_read")
           return;
           }

/*
printf("l_read : size=%d p_start=%d p_dp=%d p_length=%d\n",
size,k,p_dp,p_length);
printf("         buffer=");
for (i=k;i<p_length;i++) printf("%08.8lx",((a_btyp *)buffer)[i]);
printf("\n");
*/
        /* minimum number of required bits */
        bits = B_LENGTH*b_maxl+2;
/*
printf("l_read : bits=%d\n",bits);
*/
        /* allocate output buffer */
        offset = (p_dp-k>A_D_P) ? p_dp-k-A_D_P : 0;
        i = offset+A_D_P+((p_length<A_LENGTH) ? A_LENGTH : p_length);
        if (b_maxl+2>i) i = b_maxl+2;
        if ((res = (a_btyp *)malloc((size_t)(i*sizeof(a_btyp))))==NULL)
           {
           e_trap(ALLOCATION,2,E_TMSG,56);
           E_TPOPP("l_read")
           return;
           }

#ifdef HEAP_CHECK
b_geth((a_char *)&res,(a_char *)res,(a_char *)"l_read");
#endif

        /* clear output buffer */
        B_CLEAR(res,i)
        a_e = a_b = 0;

        /* convert integer part if there is an integer part */
        if (p_dp>k) b_coni(p_dp-k,&((a_btyp *)buffer)[k],
                           &a_b,&a_e,&res[offset],&bits);
/*
printf("l_read : a_b=%d a_e=%d res=",a_b,a_e);
for (i=a_b;i<=a_e;i++) printf("%08.8lx",res[i]);
printf("\n");

printf("l_read : bits=%d\n",bits);
*/
        /* convert fraction part if any and there are still bits required */
        if (p_length>p_dp)
           {
           if (bits>0)
              b_conf(p_length-p_dp,&((a_btyp *)buffer)[p_dp],
                     &a_b,&a_e,&res[offset],&bits);
           else res[a_e] |= LSB;
           }
/*
printf("l_read : A_BEGIN=%d A_END=%d res=",a_b,a_e);
for (i=a_b;i<=a_e;i++) printf("%08.8lx",res[i]);
printf("\n");
*/
        /* eliminate trailing zeros */
        while (res[a_e]==ZERO) a_e--;

        /* eliminate leading zeros */
        while (res[a_b]==ZERO) a_b++;

        (*s)->e = A_D_P-a_b;

        res_length = a_e-a_b+1;
        length = (res_length<b_maxl) ? res_length : b_maxl;

        if (length!=(*s)->l)
           {
           if ((*s)->l)
              {
              (*s)->l = 0;
#ifdef HEAP_CHECK
b_freh((a_char *)&(*s)->m,(a_char *)(*s)->m,(a_char *)"l_read");
#endif
              B_FREE((*s)->m)
              }
           if (b_ball(length,&(*s)->m))
              {
              e_trap(ALLOCATION,2,E_TMSG,56);

              E_TPOPP("l_read")
              return;
              }
           (*s)->l = length;
           }

        /* copy mantissa digits */
        for (i=0;i<length;i++)
           (*s)->m[i] = res[i+A_D_P-(*s)->e];

        /* determine rounded result */
        (*s)->r = NOT(b_test(res_length-b_maxl,&res[a_b+b_maxl]));
        if ((rnd<0 && sign || rnd>0 && NOT(sign)) && (*s)->r ||
            rnd==0 && res_length>b_maxl && (res[a_b+b_maxl] & MSB))
           {
           if (b_bcad(b_maxl,(*s)->m))
              {
              if ((*s)->e==MAXINT)
                 e_trap(OVERFLOW,2,E_TMSG,56);
              (*s)->e++;
              }
           }

        /* free output buffer */
#ifdef HEAP_CHECK
b_freh((a_char *)&res,(a_char *)res,(a_char *)"l_read");
#endif
        free((char *)res);

        if (size!=BUFFERSIZE)
           {
#ifdef HEAP_CHECK
b_freh((a_char *)&buffer,(a_char *)buffer,(a_char *)"l_read");
#endif
           free(buffer);
           }

        E_TPOPP("l_read")
        return;
        }
