/**************************************************************************/
/*                                                                        */
/*                                 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_scan.c,v 1.2 1997/09/25 17:06:33 ae59 Exp $ */
/*
$Log: b_scan.c,v $
 * Revision 1.2  1997/09/25  17:06:33  ae59
 * Copyright-message
 *
 * Revision 1.1  1994/01/27  13:21:40  ae59
 * Put under RCS control
 *
 */
/****************************************************************/
/*                                                              */
/*      Filename        : b_scan.c                              */
/*                                                              */
/*      Entries         : int b_scan                            */
/*                        (device,buffer,size,                  */
/*                             expo,dp,length,sign,c)           */
/*                        FILE *device;                         */
/*                        char **buffer;                        */
/*                        a_intg *size;                         */
/*                        a_intg *expo;                         */
/*                        a_intg *dp;                           */
/*                        a_intg *length;                       */
/*                        a_bool *sign;                         */
/*                        int c;                                */
/*                                                              */
/*      Arguments       : device - input device reading string  */
/*                        buffer - buffer to hold string        */
/*                        size   - size of buffer               */
/*                        expo   - exponent                     */
/*                        dp     - digits before decimal point  */
/*                        length - number of digits read        */
/*                        sign   - sign of number               */
/*                        c      - first character scanned      */
/*                                                              */
/*      Description     : Scan input device for real number     */
/*                        with exponent range restricted to     */
/*                        -9999 <= expo <= 9999.                */
/*                                                              */
/*      Function value  : 0 = real number scanned               */
/*                        1 = allocation error                  */
/*                        2 = no digit in mantissa              */
/*                        3 = no digit in fraction              */
/*                        4 = no digit in exponent              */
/*                        5 = restricted exponent range         */
/*                                                              */
/*      Note            : Variable 'buffer' points to a         */
/*                        d_otpr field (b_cp__) which cannot    */
/*                        be freed. 'buffer' must be alligned   */
/*                        according to type a_btyp.             */
/*                                                              */
/*      Date            : 1993-09-16                            */
/*      1993-09-16 : cast to char*  in malloc         =b=       */
/*      1992-07-22 : cast to size_t in malloc, mem... =b=       */
/*      1991-04-24 : scan trailing digits if exceding exponent  */
/*      1991-02-18 : buffer type changed to 'char **'           */
/*                   exponent range restricted                  */
/*      1990-11-16 : integer input allowed                      */
/*      1990-09-04 : 400 replaced by 308/-307                   */
/*      1990-08-02 : variable c must be int                     */
/*      1990-07-02 : argument : int i                           */
/*                   LINT_ARGS prototype                        */
/****************************************************************/

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

#ifdef LINT_ARGS
local int b_scan(FILE *device,char **buffer,a_intg *size,
                 a_intg *expo,a_intg *dp,
                 a_intg *length,a_bool *sign,int c)
#else
local int b_scan(device,buffer,size,expo,dp,length,sign,c)

FILE *device;
char **buffer;
a_intg *size;
a_intg *expo;
a_intg *dp;
a_intg *length;
a_bool *sign;
int c;
#endif
        {
        a_intg esign;
        char *ptr;

        /* initialize data              */
        *length = *expo = *dp = 0;

        /* skip leading blanks and control codes        */
        while (c==' ' || c==EOLN) c = getc(device);

        /* sign of number                               */
        if (c=='-' || c=='+')
           {
           *sign = (c=='-') ? TRUE : FALSE;
           c = getc(device);
           }
        else
           *sign = FALSE;

        /* first character of mantissa must be a digit */
        if (!isdigit(c))
           {
           ungetc(c,device);
           return(2);
           }

        /* skip leading zeros                           */
        while (c=='0') c = getc(device);

        /* scan digits of integer part                  */
        while (isdigit(c))
           {
           if (*length>=*size)
              {
              if ((ptr = (char*) malloc((size_t)(*size+BUFFERSIZE)))==NULL) 
			  return(1);

              memcpy(ptr,*buffer,(size_t)(*size));
              if (*size!=BUFFERSIZE)
                 {
#ifdef HEAP_CHECK
b_freh((a_char *)buffer,(a_char *)*buffer,(a_char *)"b_scan");
#endif
                 free(*buffer);
                 }
#ifdef HEAP_CHECK
b_geth((a_char *)buffer,(a_char *)ptr,(a_char *)"b_scan");
#endif
              *buffer = ptr;
              *size += BUFFERSIZE;
              }
           (*buffer)[*length] = c-'0';
           (*length)++;
           c = getc(device);
           }

        /* save position of decimal point */
        *dp = *length;

        /* skip decimal point                           */
        if (c=='.')
           {
           c = getc(device);

           /* first character of fraction must be a digit */
           if (!isdigit(c))
              {
              ungetc(c,device);
              return(3);
              }

           /* scan digits of fractional part               */
           while (isdigit(c))
              {
              if (*length>=*size)
                 {
                 if ((ptr= (char*) malloc((size_t)(*size+BUFFERSIZE)))==NULL) 
				return(1);

                 memcpy(ptr,*buffer,(size_t) (*size));
                 if (*size!=BUFFERSIZE)
                    {
#ifdef HEAP_CHECK
b_freh((a_char *)buffer,(a_char *)*buffer,(a_char *)"b_scan");
#endif
                    free(*buffer);
                    }
#ifdef HEAP_CHECK
b_geth((a_char *)buffer,(a_char *)ptr,(a_char *)"b_scan");
#endif
                 *buffer = ptr;
                 *size += BUFFERSIZE;
                 }
              (*buffer)[*length] = c-'0';
              (*length)++;
              c = getc(device);
              }

           /* skip trailing blanks of fraction in buffer        */
           while (*length>*dp && (*buffer)[*length-1]=='\0') (*length)--;
           }

        /* skip letter of exponential part              */
        if (c=='e' || c=='E' )
           {
           c = getc(device);

           /* sign of exponent                          */
           if (c=='-' || c=='+')
              {
              esign = (c=='-') ? -1 : 1;
              c = getc(device);
              }
           else esign = 1;

           /* no digits in exponent                     */
           if (!isdigit(c))
              {
              ungetc(c,device);
              return(4);
              }

           /* get value of exponent                     */
           while (isdigit(c) && *expo<1000)
              {
              *expo = *expo*10+c-'0';
              c = getc(device);
              }
           *expo *= esign;

           /* scann trailing digits */
           if (isdigit(c))
              {
              do
                 c = getc(device);
              while (isdigit(c));
              ungetc(c,device);
              return(5);
              }
           }

        ungetc(c,device);
        return(0);
        }
