#ifndef lint
static char *RCSid = "$Id: strmath.c,v 1.7 1993/05/10 06:06:02 anders Exp anders $";
#endif

/*
 *  The Regina Rexx Interpreter
 *  Copyright (C) 1992-1994  Anders Christensen <anders@pvv.unit.no>
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Library General Public
 *  License as published by the Free Software Foundation; either
 *  version 2 of the License, or (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Library General Public License for more details.
 *
 *  You should have received a copy of the GNU Library General Public
 *  License along with this library; if not, write to the Free
 *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

#include "rexx.h" 
#include <stdio.h>
#include <ctype.h>
#include <assert.h>
#include <string.h>


#define log_xor(a,b)    (( (a)&&(!(b)) ) || ( (!(a)) && (b) ))
#define MAX(a,b) ((a>b)?(a):(b))
#define MIN(a,b) ((a<b)?(a):(b))
#define IS_AT_LEAST(ptr,now,min) \
   if (now<min) { if (ptr) Free(ptr); ptr=Malloc(now=min) ; } ;



/* 
   static int prec=9 ;
   static int fuzz=0 ;
   static int numform = 0 ;
 */

/* hmmm perhaps it should be rebuilt, so that 0 gave: size=0 and num 
   and exp undefined, that would be most logical ... */


#define MAX_EXPONENT (999999999)

num_descr rdescr = { NULL, 0, 0, 0, 0 } ;
num_descr sdescr = { NULL, 0, 0, 0, 0 } ;
num_descr fdescr = { NULL, 0, 0, 0, 0 } ;
num_descr edescr = { NULL, 0, 0, 0, 0 } ;



#ifdef TRACEMEM
void *outptr1=NULL, *outptr2=NULL, *outptr3=NULL, *outptr4=NULL,
     *outptr5=NULL ;

void mark_descrs()
{
   if (rdescr.num) markmemory( rdescr.num, TRC_MATH ) ;
   if (sdescr.num) markmemory( sdescr.num, TRC_MATH ) ;
   if (fdescr.num) markmemory( fdescr.num, TRC_MATH ) ;
   if (edescr.num) markmemory( edescr.num, TRC_MATH ) ;

   if (outptr1) markmemory( outptr1, TRC_MATH ) ;
   if (outptr2) markmemory( outptr2, TRC_MATH ) ;
   if (outptr3) markmemory( outptr3, TRC_MATH ) ;
   if (outptr4) markmemory( outptr4, TRC_MATH ) ;
   if (outptr5) markmemory( outptr5, TRC_MATH ) ;

}
#endif


int descr_to_int( num_descr *input ) 
{
   /* number must be integer, and must be small enough */
   int result=0, i ;

   if (input->size<input->exp)
      exiterror( ERR_INVALID_INTEGER ) ;
   else if (input->size>input->exp)
   {
      i = MAX( 0, input->exp ) ;
      for (; i<input->size; i++)
         if (input->num[i]!='0')
            exiterror( ERR_INVALID_INTEGER ) ;
   }
   

   for (i=0; i<input->size; i++)
   {
      result = result*10 + (input->num[i] - '0') ;
   }
   if (input->negative)
      result = -result ;

   return result ;
}

void str_strip( num_descr *num ) 
{
   int i, j ;

   if (num->size==1)
   {
      if (num->num[0] == '0')
      {
         num->negative = 0 ;
         num->exp = 1 ;
      }
      return ;
   }

   for (i=0; i<num->size-1 && num->num[i]=='0'; i++ ) ;
   if (i)
   {
      for (j=0; j<(num->size-i); j++)
      {
         num->num[j] = num->num[j+i] ;
      }

      num->exp -= i ;
      num->size -= i ;
      assert( num->size > 0 ) ;
   }

   if ((num->size==1) && (num->num[0]=='0'))
   {
      num->negative = 0 ;
      num->exp = 1 ;
   }
}



int getdescr( streng *num, num_descr *descr )
{
   register char *i, *k, *top, *start ;
   char *ktop, ch ;
   register int kextra, skipped ;
   register int skipzeros, decipoint, found_digits ;

   IS_AT_LEAST( descr->num, descr->max, currlevel->currnumsize+1 ) ;

   /* skip leading whitespace */
   i = num->value ;
   top = i + Str_len( num ) ;
   for ( ; (isspace(ch=*i) && i<top); i++ ) ;
 
   /* set the sign, and skip more whitespace */
   descr->negative = 0 ;
   if (((ch == '-') || (ch == '+')) && i<top)
   {
      descr->negative = (*(i++) == '-') ;
      for ( ; (i<top) && (isspace(*i)); i++ ) ;
   }

   /* This is slightly confusing ... but the conventions are:
    *
    *  decipoint - number of leading digits in descr->num that are in 
    *              front of the decimal point, if any.
    *  skipzeros - number of leading zeros in the output, _after_ the 
    *              decimal point, which has been skipped. 
    *  examples:
    *      00.0004   ->  decipoint=0   skipzeros=3
    *      123.456   ->  decipoint=3   skipzeros=0
    *      0004000   ->  decipoint=-1  skipzeros=-1
    */

   /* read all digits in number */   
   start = i ;
   kextra = 0 ;
   skipped = 0 ;
   skipzeros = -1 ;
   decipoint = -1 ;
   found_digits = 0 ;
   k = descr->num ;
   ktop = k + currlevel->currnumsize + 1 ;
   for (; i<top; i++ )
   {
      if (isdigit(ch=*i))
      {
         if (skipzeros<0)
         {
            found_digits = 1 ;
            if (ch=='0') 
            {
               if (decipoint>=0) skipped++ ;
               continue ;
            }
            else
            {
               assert( decipoint <= 0 ) ;
               skipzeros = skipped ;
            }
         }

         if (k < ktop)
            *(k++) = ch ;
         else
            kextra++ ;
      }  
      else if (ch=='.')
      {
         if (decipoint!=(-1)) 
            return 1 ;

         decipoint = k - descr->num ;
      }
      else 
         break ;
    }

   descr->exp = 0 ;
   if ((i<top) && ((ch=='e') || (ch=='E')))
   {
      int sign=0 ;
      char *tmp ;

      if ((*(++i) == '-') || (*i == '+'))
         sign = (*(i++) == '-') ;

      for (tmp=i; (i<top) && (isdigit(*i)); i++ )
         descr->exp = descr->exp * 10 + (*i - '0') ;
 
      if (tmp==i) return 1 ;
 
      if (sign)
         descr->exp = - descr->exp ;
   }

   /* If we didn't find any non-zero digits */
   descr->size = k - descr->num ;
   if (skipzeros<0)
   {
      if (!found_digits)
         return 1 ;
 
      descr->exp += 1 - skipped ;
      *(k++) = '0' ; 
      descr->size++ ;
   }
   else if (decipoint<0)
      descr->exp += descr->size + kextra ;
   else
      descr->exp += decipoint - skipzeros ;

   /* check for non-white-space at the end */
   for (; i<top; i++ ) 
      if (!isspace(*i))
         return 1 ;

   assert( descr->size <= currlevel->currnumsize+1 ) ;
   return 0 ;
}


void str_round( num_descr *descr, int size ) 
{
   int i ;

   /* we can't round to zero digits */
   if (size==0)
   {
      if (descr->num[0]>='5')
      {
         descr->num[0] = '1' ;
         descr->exp++ ;
         descr->size = 1 ;
      }
      else
      {
         descr->num[0] = '0' ;
         descr->size = 1 ;
         descr->negative = descr->exp = 0 ;
      }
      return ;
   }
   else if (size<0)
   {
      descr->num[0] = '0' ;
      descr->size = 1 ;
      descr->exp = descr->negative = 0 ;
      return ;
   }

   /* increment size by the number of leading zeros existing */
   for (i=0; i<descr->size && descr->num[i]=='0'; i++) ;
   size += i ;
   
   /* do we have to round? */
   if (descr->size<=size)
      return ;

   /* set the size to the wanted value */
   descr->size = size ;

   /* is it possible just to truncate? */
   if (descr->num[size] < '5')
      return ;

   /* increment next digit, and loop if that is a '9' */
   for (i=size-1;;)
   {
      /* can we get away with inc'ing this digit? */
      if (descr->num[i] != '9')
      {
         descr->num[i]++ ;
         return ;
      }

      /* no, set it to zero, and inc' next digit */
      descr->num[i--] = '0' ;

      /* if there are no more digits, move number one magnitude up */
      if (i==(-1))
      {
#ifndef NDEBUG
         /* Just check a few things ... I don't like surprises */
         for (i=0; i<size; i++)
            assert( descr->num[i] == '0' ) ;
#endif

         /* increase order of magnitude, and set first digit */
         descr->exp++ ;
         descr->num[0] = '1' ;
         return ;
      }
   }
}



void descr_copy( num_descr *f, num_descr *s )
{
   /* 
    * Check for the special case that these are identical, then we don't
    * have to do any copying, so just return.
    */
   if (f==s)
      return ;

   s->negative = f->negative ;
   s->exp = f->exp ;
   s->size = f->size ;
   
   IS_AT_LEAST( s->num, s->max, f->size ) ;
   memcpy( s->num, f->num, f->size ) ;
}



/*
 * 
 *
 * So, why don't we just flush the changes into the result string 
 * directly, without temporarily storing it in the out string? Well,
 * the answer is that if this function is called like:
 *
 *    string_add( &descr1, &descr2, &descr1 )
 * 
 * then it should be able to produce the correct answer, which is 
 * impossible to do without a temporary storage. (Hmmm. No, that is
 * bogos, it just takes a bit of care to not overwrite anything that
 * we might need. Must be rewritten). Another problem, if the result
 * string is to small to hold the answer, we must reallocate space
 * so we might have to live with the out anyway.
 */
void string_add( num_descr *f, num_descr *s, num_descr *r )
{
   static char *out=NULL ;
   static int outsize= 0 ;
   int count, carry, tmp, sum, neg ;
   int lsd ; /* least significant digit */
   int msd, loan, ccns ;
   int flog, fexp, fsize, slog, ssize, sexp, sdiff, fdiff ;
   char *fnum, *snum ;
 
   fexp = f->exp ;
   fsize = f->size ;
   sexp = s->exp ;
   ssize = s->size ;
   flog = f->negative & !s->negative;
   slog = s->negative & !f->negative;
   sdiff = sexp - ssize ;
   fdiff = fexp - fsize ;
   fnum = f->num ;
   snum = s->num ; 

   /* 
    * Make sure that we have enough space for the internal use.
    */
   ccns = currlevel->currnumsize ;
   IS_AT_LEAST( out, outsize, ccns+2 ) ;
#ifdef TRACEMEM
   outptr5 = out ;
#endif

   /* 
    * If *s is zero compared to *f under NUMERIC DIGITS, set it to zero 
    * This also applies if *s is zero. TRL says that in that case, the
    * other number is to be returned. 
    */
   if ((ssize==1)&&(snum[0]=='0'))
   {
      descr_copy( f, r ) ;
      return ;
   }

   /* 
    * And do  the same thing for *f 
    */
   if (( fsize==1)&&(fnum[0]=='0'))
   {
      descr_copy( s, r ) ;
      return ;
   }

   if (sexp > fexp)
   {
      if (sexp > fexp + ccns) 
      {
         descr_copy( s, r ) ;
         return ;
      }
   }
   else
   {
      if (fexp > sexp + ccns)
      {
         descr_copy( f, r ) ;
         return ;
      }
   }

   /*
    * Find the exponent number for the most significant digit and the 
    * least significant digit. 'size' is the size of the result, minus
    * any extra carry. 'count' is the loop variable that iterates 
    * through each digit.
    *
    * These initializations may look a bit complex, so there is a 
    * description of what they really means, consider the following 
    * addition:
    *
    *        xxxxx.xx
    *           yy.yyyy
    * 
    * The 'lsd' is the fourth digit after the decimal point, and is 
    * therefore set to -3. The 'msd' is the fifth digit before the 
    * decimal point, and is therefore set to 5. The size is set to 
    * the difference between them, that is 8. 
    * The 'carry' and 'loan' are initially
    * cleared.
    * 
    * Special consideration is taken, so that 'lsd' will never be more
    * so small that the difference between them are bigger than the 
    * current precision. 
    */
   msd = MAX( fexp, sexp ) ;
   lsd = MAX( msd-(currlevel->currnumsize+1), MIN( fdiff, sdiff));
   carry = loan = 0 ;

   /*
    * Loop through the numbers, from the 'lsd' to the 'msd', letting
    * 'count' have the value of the current digit.
    */

   fnum += fexp - 1 ;
   snum += sexp - 1 ;
   for (count=lsd; count<msd; count++ ) 
   {
      /* 
       * The variable 'sum' collects the sum for the addition of the
       * current digit. This is done, in five steps. First, register
       * any old value stored in 'carry' or 'loan'. 
       */
      sum = carry - loan ;

      /*
       * Then, for each of the two numbers, add its digit to 'sum'.
       * There are two considerations to be taken. First, are we 
       * within the range of that number. Then what are the sign of
       * the number. The expression of the if statement checks for 
       * the validity of the range, and the contents of the if 
       * statement adds the digit to 'sum' taking note of the sign.
       */
      if (count>=fdiff && fexp>count)
         {
             tmp = fnum[-count] - '0';
             if (flog)
                sum -= tmp ;
             else
                sum += tmp ;
         }
/*          else
            fdiff = msd ;
 */
      /*
       * Repeat previous step for the second number
       */
      if (count>=sdiff && sexp>count)
         {
            tmp = snum[-count] - '0';
            if (slog)
               sum -= tmp ;
            else
               sum += tmp ;
         }
/*         else
            sdiff = msd ; */

      /* 
       * If the sum is more than 9, we have a carry, then set 'carry'
       * and subtract 10. And similar, if the sum is less than 0, 
       * set 'loan' and add 10.
       */
      if ((carry = ( sum > 9 )))
         sum -= 10 ;

      if ((loan = ( sum < 0 )))
         sum += 10 ;

      /*
       * Flush the resulting digit to the output string. 
       */
      out[ msd - count ] = sum + '0';
   }

   neg = ( f->negative && s->negative ) ;
   IS_AT_LEAST( r->num, r->max, /*ccns+2*/ msd-lsd+3 ) ;

   fnum = r->num ;
   if ( carry )
   {
      *(fnum++) = '1' ;
   }
   else if ( loan )
   {
      int i ;
      assert( neg==0 ) ;
      neg = 1 ;
      out[0] = '0' ;
      sum = 10 ;
      for ( i=msd-lsd; i>0; i-- )
      {
         if ((out[i] = sum - (out[i]-'0') + '0') > '9')
         {
           out[i] = '0' ;
           sum = 10 ;
         }
         else
           sum = 9 ;
      }
      snum = out ;
      msd-- ;
   }
   else 
   {
      msd-- ;
   }

   r->negative = neg ;
   r->exp = msd + 1 ;
   r->size = r->exp - lsd ;

   memcpy( fnum, out+1, r->size ) ;
   str_strip( r ) ;
/*   for (; count<fsize; count++)
      fnum[count] = out[count]  ;
 */
}


streng *str_format( streng *input, int before, int after, int expp, int expt ) 
{
   static char *out ;
   static int outsize=0 ;
   int sdigs, trigger, j, size, k ;
   int decim, use_exp, use_eng ;
   char *tmp_ptr ;
   streng *result ;

   char *in_ptr ; /* ptr to current char in input string */
   char *in_end ; /* ptr to end+1 in input string */
   int exponent ; /* the value of the exponent */
   char *out_ptr ; /* ptr to current char in output string */

   if (getdescr(input,&fdescr))
      exiterror( ERR_BAD_ARITHMETIC ) ;

   str_round( &fdescr, currlevel->currnumsize ) ;

   /* 
    * Make sure that we have enough space available. If we have memory
    * tracing enabled, remember to save the info about the new memory 
    * allocated.
    */
   IS_AT_LEAST( out, outsize, 3*currlevel->currnumsize+5 ) ;
#ifdef TRACEMEM
   outptr1 = out ;
#endif

   new_round:
   /* 
    * Str_ip leading zeros from the descriptor. We could have done this
    * by calling strip(), but it is faster to do it here. Besides doing
    * it this way shortcuts the need to shift (i.e copy) the digits
    */
   str_strip( &fdescr ) ;
   exponent = fdescr.exp ;
   in_end = &fdescr.num[fdescr.size] ;
   in_ptr = fdescr.num ;

   /* 
    * Now, let us see if we've got a zero. That one is a special case,
    * and then just return a zero, no more, no less
    */
/*
   if (in_ptr==in_end)
      return Str_cre( "0" ) ;
*/
   /*
    * There are certain limits that the .exp must be within, the 32
    * bit integer can hold slightly larger numbers, so if we are outside
    * the legal range, report an error.
    */
   if ((MAX_EXPONENT<exponent-1) || ((-MAX_EXPONENT)>exponent+1))
      exiterror( ERR_ARITH_OVERFLOW ) ;

   /* 
    * Set 'sdigs' to the number of significant digits we want in the 
    * answer. Whatever the user wants, we first round off 'in' to 
    * the precision before doing anyting.
    */
   sdigs = MIN( in_end-in_ptr, currlevel->currnumsize ) ;  /* significant digits in answer */

   /* Are we in for exponential form? If the integer part is bigger
    * than a trigger value, or the decimal part bigger than twice that
    * trigger value, use exponential form. The default for trigger is 
    * the precision, but it will be expt if that is defined.
    *
    * Problem: will the setting of before and after effect the 
    * precision on such a way that it will change the representation
    * between exponential/simple form. (I don't think so?) The code 
    * that considers 'after' has therefore been commented out. Consider 
    * the problem format('0.00011111',,4,,3). Now, this number needs 
    * eight digits after the decimal point in order to be represented. 
    * On the other hand, it only need four digits, in the output. 
    * Which is the correct???  I don't know, but I think the code should
    * be commented out.
    */
   trigger = (expt!=(-1)) ? expt : currlevel->currnumsize ;
   decim = MAX( sdigs - exponent, 0 ) ;
  
   use_exp = ((decim>2*trigger) || (trigger<exponent)) ;
   if (after>(-1)) 
      decim = after ;

   /* If expp is zero, then we will never use exponential form
    */
   if (expp==0)
      use_exp = 0 ;

   /* Here comes the big question, are we going to use exponential form
    * or simple form, 'use_exp' holds the answer
    */
   if (use_exp)
   {
      /* We are going to use exponential form, now we have to check
       * whether to use scientific or engineering form. In exponential
       * form, there are *always* an integer part, which size is 1 in 
       * sci. form and 1-3 in eng. form. Now, there are a total of three
       * ways to do this: sci, eng and custom (i.e. before is set too).
       */
      use_eng = (currlevel->numform == NUM_FORM_ENG) ;

      /* If number is 99.995, we might have to reconsider the integer
       * part (even the length of the integer part) after rounding the
       * fractional part. So we better round it right away, and do 
       * something sensible if order of magnitude changed.
       */
      k = fdescr.exp ;
      if (after>(-1))
      {
         if (use_eng)
            str_round( &fdescr, after + 1 + exponent%2 ) ;
         else
            str_round( &fdescr, after + 1 ) ;

         if (k!=fdescr.exp)
            goto new_round ;
      }

      /* If 'before' was specified, we need to initialize the first 
       * chars in out to spaces, and set 'k' so we skip over them.
       */
      if (before!=(-1))
      {
         out_ptr = out + before - (fdescr.negative!=0) - 1 ;
         if (use_eng)
            out_ptr -= (exponent)%3 ;

         /* Now, check that there is enough space, and set the initial
          * characters that we are not going to use to spaces.
          */
         if (out_ptr<out)
            exiterror( ERR_ARITH_OVERFLOW ) ;

         /* Then set the initial characters to space. When this is done, 
          * we are sure (almost, at least) that there we have set k to 
          * point to the 'right' char, so that after the sign and the
          * integer part of the matissa has been written out, k will be
          * at the k'th position of the output string.
          */
         for (tmp_ptr=out; tmp_ptr<out_ptr; *(tmp_ptr++)=' ') ;
      }
      else
         out_ptr = out ;

      /*
       * Let's start with the sign, that is not effected by any of the 
       * various formats at which this routine can output 'in'
       */
      if (fdescr.negative)
         *(out_ptr++) = '-' ;

      /* Then continue with the first digit, that shall *always* be
       * written out, both in sci and eng form. 
       */
      assert( in_ptr < in_end ) ;
      *(out_ptr++) = *(in_ptr++) ;
      exponent-- ;

      /* If we use eng. form, we might have to stuff into it as much 
       * as two additional digits. And we have to watch out so we neigher
       * increase the precision nor use more digits than we are allowed
       * to do. 
       */
      if (use_eng)
      {
         for (;;)
         {
            /* Break out of this when the exponent is a multiple of three.
             */
            if ((exponent%3)==0)
               break ;
            
            /* First, check to see if there are more digits in the number
             * that we want to write out. If that is ok, then just write
             * the whole thing out.
             */
            if (in_ptr >= in_end)
               exiterror( ERR_ARITH_OVERFLOW ) ;
            *(out_ptr++) = *(in_ptr++) ;

            exponent-- ;
         }
      }

      /* OK, now we have written out the integer part of the matissa. Now
       * we must follow with the decimal part. First of all, let us start 
       * with the decimal point, which should only be present if the 
       * actually are a decimal part. 
       */
      if (after==(-1))
         after = in_end - in_ptr ;

      if (after>0) 
         *(out_ptr++) = '.' ;

      /* At last we have to to fill in the digits in the decimal part of
       * the matissa. Just loop through it.
       */
      for (; (after) && (in_ptr < in_end); after--) 
         *(out_ptr++) = *(in_ptr++) ;

      /* And then we have to add the required number of tailing zeros in
       * the matissa
       */
      for (; after; after--) 
         *(out_ptr++) = '0' ;

      /* Then comes the exponent. It should not be written if the 
       * exponent is one. On the other hand, if a particular size is 
       * requested for the exponent in expp, then the appropriate number
       * of space should be filled in.
       */
      if (exponent)
      {
         *(out_ptr++) = 'E' ;
         *(out_ptr++) = (exponent>0) ? '+' : '-' ;
         
         if (exponent<0)
            exponent = -exponent ;

         /* Now, suppose that expp is unspecified, then we would have to 
          * find the number of characters needed for the exponent. The 
          * following is a kludge to set expp to the 'right' number if
          * it was previously unset.
          */
         if (expp==(-1)) 
            for (k=exponent,expp=0; k; k/=10, expp++) ;

         /* We have to fill in numbers from the end of it, and pad with 
          * zeros to the left. First find the end, and then loop backwards
          * for each significant digit in exponent 
          */
         for (tmp_ptr=out_ptr+expp-1;;)
         {
            /* First check for overflow, i.e the space reserved in the 
             * exponent is not enough to hold it. 
             */
            if (tmp_ptr<out_ptr) 
               exiterror( ERR_ARITH_OVERFLOW ) ;

            /* Then extract the decimal digit and put it into the output
             * string, while deviding the exponent by ten.
             */
            *(tmp_ptr--) = exponent%10 + '0' ;
            exponent /= 10 ;

            /* The only possible way out of this is when the exponent is
             * zero, i.e. it has been written out. (unless an error is 
             * trapped in the lines above.)
             */
            if (!exponent)
               break ;
         }

         /* Now there might be some chars left in the exponent that has
          * to be set to leading zeros, check it and do it.
          */
         for (; tmp_ptr>=out_ptr;)
            *(tmp_ptr--) = '0' ;

         /* At last, set k, so that we know the real size of the out
          * string.
          */
         out_ptr += expp ;
      }
      else if (expp!=(-1))
         for (j=(-2); j<expp; j++)
           *(out_ptr++) = ' ' ;
   }
   else
   {
      /* If number is 99.995, we might have to reconsider the integer
       * part (even the length of the integer part) after rounding the
       * fractional part. So we better round it right away, and do 
       * something sensible if order of magnitude changed.
       */
      after = decim ;
      k = fdescr.exp ;
      if (after>(-1))
      {
         str_round( &fdescr, after + fdescr.exp ) ;
         if (k!=fdescr.exp)
            goto new_round ;
      }

      out_ptr = out ;
      /* We are not going to use an exponent. Our number will consist of
       * two parts, the integer part, and the fractional part. Let us 
       * concentrate on the integer part, which will have a particular
       * length if before is set.
       */
      if (before>(-1))
      {
         /* Since the integer part is going to have a particular length, 
          * we better find that lenght, and skip the initial part (or 
          * give an error if the length given is too small for this 
          * number. Remember that we need at least on digit before the 
          * decimal point (the leading zero).
          */
         size = (fdescr.negative) + MAX(exponent, 1) ;
        
         /* Does the integer part of the output string hold enough chars?
          * If not, report an error. If is does, initialize the first
          * part of it (the unused part) to spaces.
          */
         if (size>before)
            exiterror( ERR_ARITH_OVERFLOW ) ;
         else
            for (k=0; k<(before-size); k++) 
               *(out_ptr++) = ' ' ;
      }

      /* Write out the sign if it is needed, and then loop trough the
       * digits of the integer part of the number. If the integer part
       * in empty, write out a "0" instead.
       */
      if (fdescr.negative)
         *(out_ptr++) = '-' ;

      if (exponent>0)
         for (; (exponent) && (in_ptr<in_end); exponent--)
            *(out_ptr++) = *(in_ptr++) ;
      else
         *(out_ptr++) = '0' ;

      /*
       * If the number doesn't have enough digits to fill the integer
       * part, help it, and fill it with zeros.
       */
      if (exponent>0)
         for (; exponent; exponent--)
            *(out_ptr++) = '0' ;

      /* Now has the time come for the decimal points, which is only
       * to be written out if there actually are decimals, and if 
       * the size of the decimal part is non-zero. First find the 
       * number of decimals, and stuff it into the 'size' variable
       */
      if (after>(-1))
         after = after ;
      else
         after = in_end - in_ptr ;

      /* If there are decimals, write the decimal point 
       */
      if (after>0)
         *(out_ptr++) = '.' ;

      /* Then write the leading zeros after the decimal point, but 
       * before the first digit in the number, if there are any
       */
      for (j=0; (j<after) && (exponent<0); exponent++, j++)
         *(out_ptr++) = '0' ;

      /* And then loop through the decimals, and write them out. 
       * Remember that size might be larger than the actual number
       * of decimals available.
       */
      for (; (in_ptr<in_end) && (j<after); j++)
         *(out_ptr++) = *(in_ptr++) ;

      /* Then append the right number of zeros, to pad the number
       * to the wanted length. Here k is the length of the number
       */
      for (; j<after; j++) 
         *(out_ptr++) = '0' ;
   }

   result = Str_make( out_ptr - out ) ;
   memcpy( result->value, out, result->len=out_ptr-out ) ;
   return result ;
}


#define OPTIMIZE
#ifdef OPTIMIZE


streng *str_norm( num_descr *in, streng *try ) 
{
   static char *out = NULL ;
   static int outsize=0 ;
   streng *result ;
   char frst ;
   int i, j, k=0, p=0 ;
   int sdigs, top ;
   int size, exp ;

   IS_AT_LEAST( out, outsize, 3*currlevel->currnumsize+5 ) ;
#ifdef TRACEMEM
   outptr2 = out ;
#endif

   if (in->negative)
      out[k++] = '-' ;

   /* remove effect of leading zeros in the descriptor */
   for ( i=0; i<in->size ; i++)
      if ( in->num[i]!='0' ) 
         break ;

   exp = in->exp ;
   if (i==in->size)
   {
      in->size = in->exp = 1 ;
      in->negative = 0 ;
      in->num[0] = '0' ;
      if (try)
      {
         assert( try->max > 0 ) ;
         try->value[0] = '0' ;
         try->len = 1 ;
      }
      else
         try = Str_cre( "0" ) ;
      return try ;
   }
   else
     size = in->size ;

   if ((MAX_EXPONENT+1<exp) || ((-MAX_EXPONENT-1)>exp))
   {
      exiterror( ERR_ARITH_OVERFLOW ) ;
      return NULL ;
   }

   exp -= top = i ;               /* adjust the exponent */
   sdigs = MIN( size-i, currlevel->currnumsize ) ;  /* significant digits in answer */

   if (( sdigs - exp > 2*currlevel->currnumsize ) || ( sdigs < exp ))
   {

      if ((size-i > currlevel->currnumsize) && (in->num[currlevel->currnumsize+i] > '4'))
      {
         for (j=currlevel->currnumsize+i-1; j>=i; j--)
            if (((in->num[j])++)=='9')
               in->num[j] = '0' ;
            else
               break ;

         if (j<i)
         {
            in->num[i] = '1' ;
            exp++ ;
         }
      }

      frst = out[k++] = ( i<size ) ? in->num[i++] : '0' ;
      if (i<size && (1<=currlevel->currnumsize-(frst!='0')))
         out[k++] = '.' ;
     
      for (j=1; (i<size) && (j<=currlevel->currnumsize-(frst!='0')); j++ )
         out[k++] = in->num[i++] ;

      /* avrunding */
      j = exp - 1 ;
      out[k++] = 'E' ;
      sprintf( &out[k], "%+d", j ) ;
      
      return Str_cre( out ) ;
   }
   
   if (exp <= 0)
   {
      out[k++] = '0' ;
      if (exp<0)
      {
         out[k++] = '.' ;
         for ( j=0; j>exp; j-- )
            out[k++] = '0' ;
      }
   }

   top = MIN( sdigs, currlevel->currnumsize ) + i ;
   if ((size-i > currlevel->currnumsize) && (in->num[currlevel->currnumsize+i] > '4'))
   {
      for (j=currlevel->currnumsize+i-1; j>=i; j--)
         if (((in->num[j])++)=='9')
            in->num[j] = '0' ;
         else
            break ;

      if (j<i)
      {
         top-- ;
         p += out[k++] = '1' ;
      }
   }

   j = exp ;
   for (; i<top; i++ )
   {
      if (j--==0)
         out[k++] = '.' ;

      p += (out[k++] = in->num[i]) - '0' ;
   }
   if (p==0)
      out[(k=1)-1] = '0' ;

   if (try)
   {
      if (try->max>=k)
          result = try ;
      else
      {
          result = Str_make( k ) ;
          Free_string( try ) ;
      }
   }
   else
      result = Str_make( k ) ;

   memcpy( result->value, out, result->len=k ) ;
   return result ;
}

#else


streng *str_norm( num_descr *in, streng *try ) 
{
   static char *out = NULL ;
   static int outsize=0 ;
   streng *result ;
   char frst ;
   int i, j, k=0, p=0 ;
   int sdigs, top ;
   int exp, size, neg ;

   IS_AT_LEAST( out, outsize, 3*currlevel->currnumsize+5 ) ;
#ifdef TRACEMEM
   outptr2 = out ;
#endif

   if (in->negative)
      out[k++] = '-' ;

   /* remove effect of leading zeros in the descriptor */
   for ( i=0; i<in->size ; i++)
      if ( in->num[i]!='0' ) 
         break ;

   exp = in->exp ;
   size = in->size ;
   neg = in->negative ;
   if (i==size)
     size = exp = neg = 0 ;

   if ((MAX_EXPONENT+1<exp) || ((-MAX_EXPONENT)-1>exp))
      exiterror( ERR_ARITH_OVERFLOW ) ;

   exp -= top = i ;               /* adjust the exponent */
   sdigs = MIN(size-i,currlevel->currnumsize); /* significant digits in answer */

   if (( sdigs - exp > 2*currlevel->currnumsize ) || ( sdigs < exp ))
   {

      if ((size-i > currlevel->currnumsize) && (in->num[currlevel->currnumsize+i] > '4'))
      {
         for (j=currlevel->currnumsize+i-1; j>=i; j--)
            if (((in->num[j])++)=='9')
               in->num[j] = '0' ;
            else
               break ;

         if (j<i)
         {
            in->num[i] = '1' ;
            exp++ ;
         }
      }


      frst = out[k++] = ( i<size ) ? in->num[i++] : '0' ;
      if (i<size)
         out[k++] = '.' ;
     
      for (j=1; (i<size) && (j<=currlevel->currnumsize-(frst!='0')); j++ )
         out[k++] = in->num[i++] ;

      /* avrunding */
      j = exp - 1 ;
      out[k++] = 'E' ;
      sprintf( &out[k], "%+d", j ) ;
      
      return Str_cre( out ) ;
   }
   
   if (exp <= 0)
   {
      out[k++] = '0' ;
      if (exp<0)
      {
         out[k++] = '.' ;
         for ( j=0; j>exp; j-- )
            out[k++] = '0' ;
      }
   }

   top = MIN( sdigs, currlevel->currnumsize ) + i ;
   if ((size-i > currlevel->currnumsize) && (in->num[currlevel->currnumsize+i] > '4'))
   {
      for (j=currlevel->currnumsize+i-1; j>=i; j--)
         if (((in->num[j])++)=='9')
            in->num[j] = '0' ;
         else
            break ;

      if (j<i)
      {
         top-- ;
         p += out[k++] = '1' ;
      }
   }

   j = exp ;
   for (; i<top; i++ )
   {
      if (j--==0)
         out[k++] = '.' ;

      p += (out[k++] = in->num[i]) - '0' ;
   }
   if (p==0)
      out[(k=1)-1] = '0' ;

   if (try)
   {
      if (try->max>=k)
          result = try ;
      else
      {
          result = Str_make( k ) ;
          Free_string( try ) ;
      }
   }
   else
      result = Str_make( k ) ;

   memcpy( result->value, out, result->len=k ) ;
   return result ;
}


#endif


int string_test2( streng *str, num_descr *num )
{
   int max, count, tmp ;

   if (num->exp > str->len)
      return -1 ;

   if (num->exp < str->len)
      return 1 ;

   assert( num->exp == str->len) ;
   max = str->len ;
   for (count=0; count<max; count++)
   {
      tmp = num->num[count] - str->value[count] ;
      if (tmp)
         return (tmp>0) ? 1 : -1 ;
   }
   return 0 ;
}



int string_test( num_descr *first, num_descr *second )
{
   int i, top, fnul, snul ;
   char fchar, schar ;

   if ( first->negative != second->negative )  /* have different signs */
      return ( first->negative ? -1 : 1 ) ;

   fnul = ( first->size==1 && first->exp==1 && first->num[0]=='0') ;
   snul = ( second->size==1 && second->exp==1 && second->num[0]=='0') ;
   if (fnul || snul)
   {
      if (fnul && snul) return 0 ;
      if (fnul) return (second->negative ? 1 : -1 ) ;
      else      return (first->negative ? -1 : 1 ) ;
   }

   if ( first->exp != second->exp ) /* have different order */
      return (log_xor( first->negative, first->exp>second->exp ) ? 1 : -1 ) ;

   /* same order and sign, have to compare currlevel->currnumsize-currlevel->numfuzz first */
   top = MIN( currlevel->currnumsize-currlevel->numfuzz, MAX( first->size, second->size )) ;
   for ( i=0; i<top; i++ )
   {
      fchar = (first->size > i) ? first->num[i] : '0' ;
      schar = (second->size > i) ? second->num[i] : '0' ;
      if ( fchar != schar ) 
         return log_xor( first->negative, fchar>schar ) ? 1 : -1 ;
   }

   /* hmmm, last resort: can the numbers be rounded to make a difference */
   fchar = (first->size > i) ? first->num[i] : '0' ;
   schar = (second->size > i) ? second->num[i] : '0' ;
   if (((fchar>'4') && (schar>'4')) || ((fchar<'5') && (schar<'5')))
      return 0 ;  /* equality! */

   /* now, one is rounded upwards, the other downwards */
   return log_xor( first->negative, fchar>'5' ) ? 1 : -1 ;
}



num_descr *string_incr( num_descr *input ) 
{
   int last ;
   char *cptr ;

   assert( input->size > 0 ) ;

   if (input->size != input->exp || input->exp >= currlevel->currnumsize)
   {
      static num_descr one = { "1", 0, 1, 1, 1 } ;

      string_add( input, &one, input ) ;
      str_round(input,currlevel->currnumsize) ;
      return input ;
   }
 
   cptr = input->num ;
   last = input->size-1 ;
   
   while (1)
   {
      if (input->negative)
      {
         if (cptr[last] > '1')
         {
            cptr[last]-- ; 
            return input ;
         }
         else if (cptr[last]=='1')
         {
            cptr[last]-- ;
            if (last==0)
               str_strip( input ) ;
            return input ;
         }
         else
         {
            assert( cptr[last] == '0' ) ;
            assert( last ) ;
            cptr[last--] = '9' ;
         }
      }
      else
      {
         if (cptr[last] < '9')
         {
            cptr[last]++ ;
            return input ;
         }
         else 
         {
            assert( cptr[last] == '9' ) ;
            cptr[last--] = '0' ;
         }
      }

      if (last<0)
      {
         if (input->size >= input->max)
         {
            char *new ;
  
            assert( input->size == input->max ) ;
            new = Malloc( input->max * 2 + 2 ) ;
            memcpy( new+1, input->num, input->size ) ;
            new[0] = '0' ;
            input->size++ ;
            input->exp++ ;
            input->max = input->max*2 + 2 ;
            Free( input->num ) ;
            cptr = input->num = new ;
         }
         else
         {
            memmove( input->num+1, input->num, input->size ) ;
            input->size++ ;
            input->exp++ ;
            input->num[0] = '0' ;
         }
         last++ ;
      }
   }
}



void string_div( num_descr *f, num_descr *s, num_descr *r, int type )
{
   static char *out=NULL ;
   static int outsize=0 ;
   int ssize, tstart, tcnt, finished=0, tend ;
   int i, cont, outp, test, loan ;
   int origneg, origexp ;

   IS_AT_LEAST( out, outsize, (currlevel->currnumsize+1)*2+1 ) ;
   IS_AT_LEAST( r->num, r->max, currlevel->currnumsize+1 ) ;
#ifdef TRACEMEM
   outptr3 = out ;
#endif

   ssize = MIN( s->size, currlevel->currnumsize+1 ) ;
   r->exp = 1 + f->exp - s->exp ; 
   r->negative = log_xor( f->negative, s->negative ) ;

   /* initialize the pointers */
   tstart = 0 ; 
   tend = tstart + MIN( f->size, currlevel->currnumsize+1 ) ;

   /* first, fill out tmp to the size of ssize */
   for (tcnt=tstart; tcnt< ssize; tcnt++ )
      out[tcnt] = (tcnt<tend) ? f->num[tcnt] : '0' ;

   /* if the ssize first digits in f->num form a number which is smaller */
   /* than s->num, we must add an additional digit to f->num */

   for (i=0; i<ssize; i++)
      if ( out[i] > s->num[i] ) 
         break ; 
      else if ( out[i] < s->num[i] ) 
      {
         out[tcnt] = (tcnt<tend) ? f->num[tcnt] : '0' ;
         tcnt++ ;
         r->exp-- ;
         break ;
      }

   /* situation: s->num[1..ssize] contains the devisor, and the array   */
   /* out[tstart==0..tcnt-1] hold the (first part of the) devidend. The */
   /* array f->num[tcnt..tend-1] (which may be empty) holds the last    */
   /* part of the devidend                                              */

   /* then foreach resulting digit we want */
   for (outp=0; outp<currlevel->currnumsize+1 && !finished; outp++)  
   {
      r->num[outp] = '0' ;
      if ((tcnt-tstart > ssize) && (out[tstart]=='0'))
         tstart++ ;

      /* if this is integer division, and we have hit the decimal point... */
      if ((type!=DIVTYPE_NORMAL) && (outp>=r->exp))
      {
         finished = 1 ;
         continue ;
      }

      /* try to subtract as many times as possible */
      for (cont=1; cont; )
      {
         /* can we subtract one more time? */
         if (tcnt-tstart == ssize)
            for (i=0; i<ssize; i++ )
            {
               test = out[tstart+i] - s->num[i] ;
               if (test<0)
                  cont = 0 ;
               if (test!=0)
                  break ;
            }
   
         /* if we can continue, subtract it */
         loan = 0 ;
         if (cont)
         {
            r->num[outp]++ ;
            for (i=0; i<ssize; i++)
            {
               out[tcnt-1-i] -= ( s->num[ssize-1-i] - '0' + loan ) ;
               if ((loan = (out[tcnt-1-i] < '0')))
                  out[tcnt-1-i] += 10 ;
            }
            if (loan)
            {
               /* decrement it and check for '0' */
               out[tstart] -= 1 ;
               if ((tcnt-tstart > ssize) && (out[tstart]=='0'))
                  tstart++ ;               
            }

         }
      } /* for each possible subtraction */

      if ((tcnt-tstart > ssize) && (out[tstart]=='0'))
         tstart++ ;

      /* do we have anything left of the devidend, only meaningful if   */
      /* all digits in original divident have been processed, it is     */
      /* also safe to assume that divident and devisor have equal size  */

      assert( tcnt-tstart == ssize ) ;
      out[tcnt] = (tcnt<tend) ? f->num[tcnt] : '0' ;
      if (++tcnt > tend) 
      {
         finished = 1 ;
         for (i=tstart; i<tcnt; i++)
            if (out[i]!='0')
            {
               finished = 0 ;
               break ;
            }
      }
   
   } /* for each digit wanted in the result */

   origexp = f->exp ;
   origneg = f->negative ;

   if (type==DIVTYPE_BOTH) /* fool it into returning both answers, yuk! */
   {
      IS_AT_LEAST( f->num, f->max, outp ) ;

      memcpy(f->num, r->num, outp) ;
      f->negative = r->negative ;
      f->size = r->size ;
      f->exp = r->exp ;         

      for (f->size = outp; (f->size > f->exp) && (f->size > 1); f->size--)
         if (f->num[f->size-1]!='0')
             break ;
   }

   if ((type == DIVTYPE_REMINDER) || (type == DIVTYPE_BOTH))
   {
      /* we are really interested in the reminder, so swap things */
      for (i=0; i<MIN(MAX(tend,tcnt)-tstart,currlevel->currnumsize+1); i++ )
         r->num[i] = (i<tcnt-tstart ? out[tstart+i] : f->num[tstart+i]) ;

      r->size = outp = i ;
      r->exp = origexp - tstart ;
      r->negative = origneg ;
   }

   /* then, at the end, we have to strip of trailing zeros that come */
   /* after the decimal point, first do we have any decimals?        */
   for (r->size = outp; (r->size > r->exp) && (r->size > 1); r->size--)
      if (r->num[r->size-1]!='0')
          break ;
}




/* The multiplication table for two single-digits numbers */
char mult[10][10][3] = {
   { "00", "00", "00", "00", "00", "00", "00", "00", "00", "00" },
   { "00", "01", "02", "03", "04", "05", "06", "07", "08", "09" },
   { "00", "02", "04", "06", "08", "10", "12", "14", "16", "18" },
   { "00", "03", "06", "09", "12", "15", "18", "21", "24", "27" },
   { "00", "04", "08", "12", "16", "20", "24", "28", "32", "36" },
   { "00", "05", "10", "15", "20", "25", "30", "35", "40", "45" },
   { "00", "06", "12", "18", "24", "30", "36", "42", "48", "54" },
   { "00", "07", "14", "21", "28", "35", "42", "49", "56", "63" },
   { "00", "08", "16", "24", "32", "40", "48", "56", "64", "72" },
   { "00", "09", "18", "27", "36", "45", "54", "63", "72", "81" },
} ;


void string_mul( num_descr *f, num_descr *s, num_descr *r ) 
{
   static char *out=NULL ;
   static int outsize= 0 ;
   char *outp, *answer ;
   int i, sskip, fskip, sstart, fstart, base, offset, carry, j ;

   IS_AT_LEAST( out, outsize, 2*(currlevel->currnumsize+1) ) ;
#ifdef TRACEMEM
   outptr4 = out ;
#endif

   for (i=0; i<2*(currlevel->currnumsize+1); out[i++]='0') ;
   outp = &out[2*(currlevel->currnumsize+1)-1] ;

   for (sskip=0; (sskip<s->size) && (s->num[sskip]=='0'); sskip++ ) ;
   sstart = MIN( sskip+currlevel->currnumsize+1, s->size-1 ) ;

   for (fskip=0; (fskip<f->size) && (f->num[fskip]=='0'); fskip++ ) ;
   fstart = MIN( fskip+currlevel->currnumsize+1, f->size-1 ) ;
   
   base = 2*(currlevel->currnumsize+1)-1 ;
   offset = carry = 0 ;
   for ( i=sstart; i>=sskip; i-- )
   {
      offset = carry = 0 ;
      assert( base >= 0 ) ;
      for ( j=fstart; j>=fskip; j-- )
      {
         answer = mult[f->num[j]-'0'][s->num[i]-'0'] ;
         assert( base-offset >= 0 ) ;
         out[base-offset] += answer[1] - '0' + carry ;
         carry = answer[0] - '0' ;
         for (; out[base-offset]>'9'; )
         {
            out[base-offset] -= 10 ;
            carry++ ;
         }
         offset++ ;
      }
      if (base-offset >= 0)
         out[base-offset++] = carry + '0' ;
      else
         exiterror( ERR_INTERPRETER_FAILURE ) ;

      base-- ;      
   }
   
   IS_AT_LEAST( r->num, r->max, /*2*(currlevel->currnumsize+1)*/ 
                              outp-out-base+offset  ) ;
   j = 0 ;
   for (i=base-offset+2; (i<=outp-out); i++ )
      r->num[j++] = out[i] ;

   if (j==0)
   {
      r->num[j++] = '0' ;
      r->exp = 1 ;
   }
   else
      r->exp = s->exp + f->exp ;

   r->negative = log_xor( f->negative, s->negative ) ;
   r->size = j ;
   str_round( r, currlevel->currnumsize ) ;
}


void descr_strip( num_descr *from, num_descr *to ) 
{
   int i, j ;

   IS_AT_LEAST( to->num, to->max, currlevel->currnumsize+1 ) ;
   
   to->negative = from->negative ;
   for (i=0; (i<from->size) && (from->num[i]=='0'); i++ ) ;
   to->exp = from->exp - i ;
   for (j=0; j+i<from->size; j++ ) 
      to->num[j] = from->num[i+j] ;

   if ((to->exp-1 > MAX_EXPONENT) || ( -MAX_EXPONENT > to->exp+1))
      exiterror( ERR_ARITH_OVERFLOW ) ;

   to->size = j ;
   
}



void string_pow( num_descr *num, int power, num_descr *acc, num_descr *res )
{
   static num_descr one = { "1", 0, 1, 1, 2 } ;
   int ineg, pow, cnt ;

   IS_AT_LEAST( res->num, res->max, currlevel->currnumsize+1 ) ;
   IS_AT_LEAST( acc->num, acc->max, currlevel->currnumsize+1 ) ;
   
   acc->exp = 1 ;
   acc->size = 1 ;
   acc->negative = 0 ;
   acc->num[0] = '1' ;

   if (ineg = ((pow = power) < 0))
      pow = power = - pow ;

   for (cnt=0; pow; cnt++ )
      pow = pow>>1 ;

   for ( ;cnt ; )
   {
      if (power & (1<<(cnt-1)))
      {
         /* multiply acc with *f, and put answer into acc */
         string_mul( acc, num, res ) ;
         assert( acc->size <= acc->max && res->size <= res->max ) ;
         descr_strip( res, acc ) ;
         assert( acc->size <= acc->max && res->size <= res->max ) ;
      }

      if ((--cnt)==0)
         break ;   /* horrible example of dataflow */

      /* then, square the contents of acc */
      string_mul( acc, acc, res ) ;
      assert( acc->size <= acc->max && res->size <= res->max ) ;
      descr_strip( res, acc ) ;
      assert( acc->size <= acc->max && res->size <= res->max ) ;
   }

   if (ineg)
      /* may hang if acc==zero ? */
      string_div( &one, acc, res, DIVTYPE_NORMAL ) ;
   else
      descr_strip( acc, res ) ;
   assert( acc->size <= acc->max && res->size <= res->max ) ;
}


/* ========= interface routines to the arithmetic routines ========== */

streng *str_add( streng *first, streng *second ) 
{
   if ( getdescr( first, &fdescr ) || getdescr( second, &sdescr ) )
      exiterror( ERR_BAD_ARITHMETIC ) ;

   string_add( &fdescr, &sdescr, &rdescr ) ;
   return str_norm( &rdescr, NULL ) ;
}


streng *str_add2( void *descr, streng *second ) 
{
    if (getdescr( second, &sdescr ))
      exiterror( ERR_BAD_ARITHMETIC ) ;

   string_add( (num_descr*)descr, &sdescr, &rdescr ) ;
   return str_norm( &rdescr, NULL ) ;
}




streng *str_sub( streng *first, streng *second )
{
   if (getdescr( first, &fdescr ) || getdescr( second, &sdescr ))
      exiterror( ERR_BAD_ARITHMETIC ) ;

   sdescr.negative = ! sdescr.negative ;   /* to make it an subtraction */
   string_add( &fdescr, &sdescr, &rdescr ) ;
   return str_norm( &rdescr, NULL ) ;
}   


streng *str_mul( streng *first, streng *second ) 
{
   if (getdescr( first, &fdescr ) || getdescr( second, &sdescr ))
      exiterror( ERR_BAD_ARITHMETIC ) ;

   string_mul( &fdescr, &sdescr, &rdescr ) ;
   return str_norm( &rdescr, NULL ) ;
}


int str_test( streng *first, streng *second )
{
   if (getdescr( first, &fdescr ) || getdescr( second, &sdescr ))
      exiterror( ERR_BAD_ARITHMETIC ) ;

   return string_test( &fdescr, &sdescr ) ;
}


/* for shortcut in do-loops, dont have to redo getdescr on increment 
 * and expr_end, that can save quite some cycles, but interpret need
 * some way to store them first
 */
int str_test2( void *second, streng *first ) 
{
   if (getdescr( first, &fdescr ))
      exiterror( ERR_BAD_ARITHMETIC ) ;

   return string_test( &fdescr, (num_descr *)second ) ;
}

/* for another shortcut, two strings are supplied, if both are 
 * numeric string, sign(a-b) is returned; else 2 is returned. 
 */
int str_test3( streng *first, streng *second )
{
   if (getdescr( first, &fdescr) || getdescr( second, &sdescr))
      return 2 ;

   return string_test( &fdescr, &sdescr ) ;
}



int descr_sign( void *descr )
{
    return( ((num_descr*)descr)->negative ? -1 : 1 ) ;
}


void free_a_descr( void *in ) 
{
   assert( ((num_descr*)(in))->size <= ((num_descr*)(in))->max ) ;

   if ( ((num_descr*)in)->num )
      Free( ((num_descr*)in)->num ) ;

   Free( (num_descr*)in ) ;
}


void *get_a_descr( streng *num ) 
{
   num_descr *descr ;

   descr=Malloc( sizeof(num_descr)) ;   
   descr->max = 0 ;
   descr->num = NULL ;

   if (getdescr( num, descr ))
      exiterror( ERR_BAD_ARITHMETIC ) ;

   return (void*)descr ;
}


streng *str_all_div( streng *first, streng *second, int type )
{
   if (getdescr( first, &fdescr ) || getdescr( second, &sdescr ))
      exiterror( ERR_BAD_ARITHMETIC ) ;
   
   if ((sdescr.size==1) && (sdescr.num[0]=='0'))
      exiterror( ERR_ARITH_OVERFLOW ) ;

   string_div( &fdescr, &sdescr, &rdescr, type ) ;
   return str_norm( &rdescr, NULL ) ;
}


streng *str_pow( streng *first, streng *second ) 
{
   int oprec, power ;

   if (getdescr( first, &fdescr ))
      exiterror( ERR_BAD_ARITHMETIC ) ;

   power = myatol( second ) ;

   oprec = currlevel->currnumsize ;
   currlevel->currnumsize += sdescr.size ; 
                             /* temporary set the precision */

   string_pow( &fdescr, power, &sdescr, &rdescr ) ;

   currlevel->currnumsize = oprec ;
   return str_norm( &rdescr, NULL ) ;
}


streng *str_neg( streng *input )
{
   if (getdescr( input, &fdescr ))
      exiterror( ERR_BAD_ARITHMETIC ) ;

   fdescr.negative = (!fdescr.negative) ;
   return str_norm( &fdescr, NULL ) ;
}


streng *str_log_and( streng *first, streng *second )
{
   if ((getdescr(first,&fdescr)) || (getdescr(second,&sdescr)))
      exiterror( ERR_BAD_ARITHMETIC ) ;

   if ((fdescr.negative) || (fdescr.exp!=1) || (fdescr.size!=1))
      exiterror( ERR_UNLOGICAL_VALUE ) ;
      
   if ((sdescr.negative) || (sdescr.exp!=1) || (sdescr.size!=1))
      exiterror( ERR_UNLOGICAL_VALUE ) ;
      
   if ((fdescr.num[0]=='1') && (sdescr.num[0]=='1'))
      return Str_cre( "1" ) ;
   else
      return Str_cre( "0" ) ;
}


streng *str_log_xor( streng *first, streng *second )
{
   if ((getdescr(first,&fdescr)) || (getdescr(second,&sdescr)))
      exiterror( ERR_BAD_ARITHMETIC ) ;

   if ((fdescr.negative) || (fdescr.exp!=1) || (fdescr.size!=1))
      exiterror( ERR_UNLOGICAL_VALUE ) ;
      
   if ((sdescr.negative) || (sdescr.exp!=1) || (sdescr.size!=1))
      exiterror( ERR_UNLOGICAL_VALUE ) ;
      
   if ((fdescr.num[0]=='1') ^ (sdescr.num[0]=='1'))
      return Str_cre( "1" ) ;
   else
      return Str_cre( "0" ) ;
}



streng *str_log_or( streng *first, streng *second )
{
   if ((getdescr(first,&fdescr)) || (getdescr(second,&sdescr)))
      exiterror( ERR_BAD_ARITHMETIC ) ;

   if ((fdescr.negative) || (fdescr.exp!=1) || (fdescr.size!=1))
      exiterror( ERR_UNLOGICAL_VALUE ) ;
      
   if ((sdescr.negative) || (sdescr.exp!=1) || (sdescr.size!=1))
      exiterror( ERR_UNLOGICAL_VALUE ) ;
      
   if ((fdescr.num[0]=='1') || (sdescr.num[0]=='1'))
      return Str_cre( "1" ) ;
   else
      return Str_cre( "0" ) ;
}



int str_true( streng *input ) 
{
   if (input->len != 1)
      exiterror( ERR_UNLOGICAL_VALUE ) ;
      
   switch (input->value[0])
   {
      case '1':
         return 1 ; 
      case '0':
         return 0 ;
      default:
         exiterror( ERR_UNLOGICAL_VALUE ) ;
   }

   /* Too keep the compiler happy */
   return 1 ;     

/*
   if (getdescr(input,&fdescr))
      exiterror( ERR_UNLOGICAL_VALUE ) ;

   if ((fdescr.negative) || (fdescr.exp!=1) || (fdescr.size!=1))
      exiterror( ERR_UNLOGICAL_VALUE ) ;

   if ((fdescr.num[0]!='0')&&(fdescr.num[0]!='1'))
      exiterror( ERR_UNLOGICAL_VALUE ) ;

   return (fdescr.num[0]=='1') ;
 */
}


streng *str_abs( streng *input) 
{
   if (getdescr(input,&fdescr))
      exiterror( ERR_BAD_ARITHMETIC ) ;

   fdescr.negative = 0 ;
   return str_norm( &fdescr, NULL ) ;
}


streng *str_trunc( streng *number, int deci ) 
{
   int i, j, k, size, top ;
   streng *result ;

   /* first, convert number to internal representation */
   if (getdescr( number, &fdescr ))
      exiterror( ERR_BAD_ARITHMETIC ) ;
   
   /* get rid of possible excessive precision */
   if (fdescr.size>currlevel->currnumsize)
      str_round( &fdescr, currlevel->currnumsize ) ;

   /* who big must the result string be? */
   if ((i=fdescr.exp) > 0 ) 
      size = fdescr.exp + deci ;
   else
      size = deci ;

   result = Str_make( size + 2 ) ;  /* allow for sign and decimal point */
   j = 0 ;

   if (fdescr.negative) 
      result->value[j++] = '-' ;   

   /* first fill in the known numerals of the integer part */
   top = MIN( fdescr.exp, fdescr.size ) ;
   for (i=0; i<top; i++)  
      result->value[j++] = fdescr.num[i] ;

   /* pad out with '0' in the integer part, if necessary */
   for (k=i; k<fdescr.exp; k++)
      result->value[j++] = '0' ;

   if (k==0)
      result->value[j++] = '0' ;

   k = 0 ;
   if (deci>0)
   {
      result->value[j++] = '.' ;

      /* pad with zeros between decimal point and number */
      for (k=0; k>fdescr.exp; k--)
         result->value[j++] = '0' ;
   }

   /* fill in with the decimals, if any */
   top = MIN( fdescr.size-fdescr.exp, deci ) + i + k ;
   for (; i<top; i++ ) 
      result->value[j++] = fdescr.num[i] ;

   /* pad with zeros if necessary */
   for (; i<deci+MIN(fdescr.exp,fdescr.size); i++ )
      result->value[j++] = '0' ;

   result->len = j ;
   assert( (result->len <= result->max) && (result->len<=size+2) ) ;
   return( result ) ;
}



/* ------------------------------------------------------------------
 * This function converts a packed binary string to a decimal integer.
 * It is equivalent of interpreting the binary string as a number of
 * base 256, and converting it to base 10 (the actual algorithm uses
 * a number of base 2, padded to a multiple of 8 digits). Negative 
 * numbers are interpreted as two's complement. 
 * 
 * First parameter is the packed binary string; second parameter is 
 * the number of initial characters to skip (i.e. the position of the
 * most significant byte in 'input'; the third parameter is a boolean
 * telling if this number is signed or not. 
 *
 * The significance of the 'too_large' variable: If the number has 
 * leading zeros, that is not an error, so the 'fdescr' might be set
 * to values larger than it can hold. However, the error occurs only 
 * if that value is used. Therefore, if 'fdescr' becomes bigger than
 * the max whole number, 'too_large' is set. If attempts are made to 
 * use 'fdescr' while 'too_large' is set, an error occurs.
 *
 * Note that this algoritm requires that string_mul and string_add  
 * does not change anything in their first two parameters. 
 *
 * The 'input' variable is assumed to have at least one digit, so don't
 * call this function with a null string. Maybe the compiler could
 * optimize this function better if [esf]descr were locals?
 */

streng *str_digitize( streng *input, int start, int sign )
{
   int cur_byte ;     /* current byte in 'input' */
   int cur_bit ;      /* current bit in 'input' */
   int too_large=0 ;  /* error flag (see above) */

   /* do we have anything to work on? */
   assert( start < Str_len(input) ) ;

   /* ensure that temporary number descriptors has enough space */
   IS_AT_LEAST( fdescr.num, fdescr.max, currlevel->currnumsize+2 ) ;
   IS_AT_LEAST( edescr.num, edescr.max, currlevel->currnumsize+2 ) ;
   IS_AT_LEAST( sdescr.num, sdescr.max, currlevel->currnumsize+2 ) ;

   /* 
    * Initialize the temporary number descriptors: 'fdescr', 'sdescr' 
    * and 'edescr'. They will be initialized to 0, 1 and 2 respectively. 
    * They are used for:
    *
    *   fdescr: contains the value of the current bit of the current 
    *           byte, e.g the third last bit in the last byte will 
    *           have the value '0100'b (=4). This value is multiplied
    *           with two at each iteration of the inner loop. Is 
    *           initialized to the value '1', and will have the same 
    *           sign as 'input'.
    * 
    *   sdescr: contains '2', to make doubling of 'fdescr' easy
    *
    *   edescr: contains the answer, initially set to '0' if 'input'
    *           is positive, or '-1' if 'input' is negative. The 
    *           descriptor 'fdescr' is added to (or implicitly 
    *           subtracted from) this number. 
    */
   fdescr.size     = sdescr.size     = edescr.size     = 1 ;
   fdescr.negative = sdescr.negative = edescr.negative = 0 ;
   fdescr.exp      = sdescr.exp      = edescr.exp      = 1 ;

   edescr.num[0] = '0' ;   /* the resulting number */
   fdescr.num[0] = '1' ;   /* the value of each binary digit */
   sdescr.num[0] = '2' ;   /* the number to multiply 'fdescr' in */

   /* 
    * If 'input' is signed, but positive, treat as if it was unsigned.
    * 'sign' is then effectively a boolean stating whether 'input' is
    * a negative number. In that case, 'edescr' should be set to '-1'.
    * Also, 'fdescr' is set to negative, so that it is subtracted from
    * 'edescr' when given to string_add().
    */
   if (sign) 
   {
      if (input->value[start] & 0x80)
      {
         edescr.num[0] = '1' ;
         edescr.negative = 1 ;
         fdescr.negative = 1 ;
      }
      else
         sign = 0 ;
   }

   /*
    * Each iteration of the outer loop will process a byte in 'input',
    * starting with the last (least significant) byte. Each iteration
    * of the inner loop will process one bit in the byte currently
    * processed by the outer loop. 
    */
   for (cur_byte=Str_len(input)-1; cur_byte>=start; cur_byte--)
   {
      for (cur_bit=0; cur_bit<8; cur_bit++)
      {
         /* does the precision hold? if not, set flag */
         if (fdescr.size > currlevel->currnumsize)
            too_large = 1 ;

         /* 
          * If the current bit (the j'th bit in the i'th byte) is set 
          * and input is positive; or if current bit is not set and 
          * input is negative, then increase the value of the result.
          * This is not really a bitwise xor, but a logical xor, but
          * the values are always 1 or 0, so it doesn't matter.
          */
         if ((sign) ^ ((input->value[cur_byte] >> cur_bit) & 1))
         {
            if (too_large)
               exiterror( ERR_INVALID_INTEGER ) ;

            string_add( &edescr, &fdescr, &edescr ) ;
         }

         /*
          * Str_ip away any leading zeros. If this is not done, the 
          * accuracy of the operation will deter, since string_add()
          * return answer with leading zero, and the accumulative 
          * effect of this would make 'edescr' zero after a few 
          * iterations of the loop.
          */
         str_strip( &edescr ) ;

         /* 
          * Increase the value of 'fdescr', so that it corresponds with
          * the significance of the current bit in 'input'. But don't 
          * do this if 'fdescr' isn't capable of holding that number. 
          */
         if (!too_large)
         {
            string_mul( &fdescr, &sdescr, &fdescr ) ;
            str_strip( &fdescr ) ;
         }
      }
   }

   /* normalize answer and return to caller */
   return str_norm( &edescr, NULL ) ;
}




streng *str_binerize( streng *number, int length ) 
{
   int i ;
   streng *result ;
   char *res_ptr ;

   /* 
    * We are going to need two number in this algoritm, so we can 
    * just as well make them right away. We could initialize these on
    * the first invocation of this routine, and thereby saving some
    * space, but that would 1) take CPU on every invocation; 2) it
    * would probably cost just as much space in the text segment. 
    * (Would have to set NUMERIC DIGIT to at least 4 before calling
    * getdescr with these.)
    */
   static num_descr minus_one = {   "1", 1, 1, 1, 2 } ;
   static num_descr byte      = { "256", 0, 3, 3, 4 } ;

   /* 
    * First, let us convert the number into a descriptor. If that is
    * not possible, then we don't have a number, which is an error.
    */
   if (getdescr( number, &edescr ))
      exiterror( ERR_BAD_ARITHMETIC ) ;

   /* 
    * If the number is negative, then we *must* know how long it is, 
    * since we are going to pad with 'ff'x bytes at the left up the
    * the wanted length. If we don't know the length, report an error.
    */
   if ((length==(-1)) && (edescr.negative))
      exiterror( ERR_INCORRECT_CALL ) ;

   /*
    * Then we have to determine if this actually is a whole number. 
    * There are two things that might be wrong: a non-zero fractional 
    * part (checked in the 'else' part below; or a insufficient 
    * precition (handled in the if part below).
    */
   if (edescr.size < edescr.exp)
   {
      exiterror( ERR_INVALID_INTEGER ) ;  
   }
   else if (edescr.size > edescr.exp)
   {
      /* 
       * Make sure that all digits in the fractional part is zero 
       */
      for (i=MIN(edescr.exp,0); i<edescr.exp; i++)
         if (edescr.num[i]!='0')
            exiterror( ERR_INVALID_INTEGER ) ;
   }

   /* 
    * If the number is zero, a special case applies, the return value
    * is a nullstring. Same if length is zero. I am not sure if this 
    * is needed, or if the rest of the algoritm is general enough to 
    * handle these cases too.
    */
   if ((length==0) /* || ((edescr.num[0]=='0') && (edescr.size=1)) */)
      result=nullstringptr() ;

   /* 
    * Here comes the real work. To ease the implementation it is 
    * devided into two parts based on whether or not length is 
    * specified. 
    */
   else if (length==(-1))
   {
      /* 
       * First, let's estimate the size of the output string that 
       * we need. A crude (over)estimate is one char for every second 
       * decimal digits. Also set length, just to chache the value.
       * (btw: isn't that MAX( ,0) unneeded? Since number don't have
       * a decimal part, and since it must have a integer part (else
       * it would be zero, and then trapped above.)
       */
      assert(edescr.exp > 0) ;
      result = Str_make( (length=(MAX(edescr.exp,0))/2) + 1 ) ;
      res_ptr = result->value ;


      /* 
       * Let's loop from the least significant part of edescr. For each
       * iteration we devide edescr by 256, stopping when edescr is 
       * zero.
       */
      for (i=length; ; i--)
      {
         /* 
          * Perform the integer divition, edescr gets the quotient, 
          * while fdescr get the reminder. Afterwards, perform some
          * makeup on the numbers (that might not be needed?)
          */
         /* may hang if acc==zero ? */
         string_div( &edescr, &byte, &fdescr, DIVTYPE_BOTH ) ;
         str_strip( &edescr ) ;
         str_strip( &fdescr ) ;

         /* 
          * Now, fdescr has the reminder, stuff it into the result string
          * before it escapes :-) (don't we have to cast lvalue here?)
          * Afterwards, check to see if there are more digits to extract.
          */
         result->value[i] = descr_to_int( &fdescr ) ;
         if ((edescr.num[0]=='0') && (edescr.size==1))
            break ;
      }

      /* 
       * That's it, now we just have to align the answer and set the 
       * correct length. Have to use memmove() since strings may 
       * overlap.
       */
      memmove( result->value, &result->value[i], length+1-i ) ;
      result->len = length + 1 - i ;
   }
   else 
   {
      /* 
       * We do have a specified length for the number. At least that 
       * makes it easy to deside how large the result string should be.
       */
      result = Str_make( length ) ;
      res_ptr = result->value ;

      /* 
       * In the loop, iterate once for each divition of 256, but stop 
       * only when we have reached the start of the result string.
       * Below, edescr gets the quotient and fdescr gets the reminder.
       */
      for (i=length-1; i>=0; i--)
      { 
         /* may hang if acc==zero ? */
         string_div( &edescr, &byte, &fdescr, DIVTYPE_BOTH ) ;
         str_strip( &edescr ) ;
         str_strip( &fdescr ) ;

         /* 
          * If the reminder is negative (i.e. quotient is negative too)
          * then add 256 to the reminder, to bring it into the range of
          * an unsigned char. To compensate for that, subtract one from
          * the quotient. Store the reminder.
          */
         if (fdescr.negative)
         {
            /* the following two lines are not needed, but it does not
               work without them. */
            if ((edescr.size==1) && (edescr.num[0]=='0'))
               edescr.exp = 1 ;

            string_add( &edescr, &minus_one, &edescr ) ;
            str_strip( &edescr ) ;
            string_add( &fdescr, &byte, &fdescr ) ;
         }
         result->value[i] = descr_to_int( &fdescr ) ;
      }
      /* 
       * That's it, store the length 
       */
      result->len = length ;
   }
  
   /* 
    * We're finished ... hope it works ...
    */
   return result ;
}


streng *str_normalize( streng *number ) 
{
   if (getdescr( number, &fdescr ))
      exiterror ( ERR_BAD_ARITHMETIC ) ;

   return str_norm( &fdescr, NULL ) ;
}



num_descr *is_a_descr( streng *number )
{
   num_descr *new ;

   if (getdescr( number, &fdescr ))
      return NULL ;

   new = Malloc( sizeof( num_descr )) ;
   new->max = 0 ;
   new->num = NULL ;
   
   descr_copy( &fdescr, new ) ;
   return new ;
}


int myiswnumber( streng *number )
{
   return (streng_to_int(number) != NULL) ;
}


int *streng_to_int( streng *number )
{
   static int result ;
   int i ;

   if (getdescr( number, &fdescr ))
      return NULL ;

   str_round( &fdescr, currlevel->currnumsize ) ;
   if (fdescr.exp > fdescr.size)  /* precision of less than one */
      return NULL ;

   i = fdescr.exp ;
   if (i<0)
      i = 0 ;
   for (; i<fdescr.size; i++)
      if (fdescr.num[i] != '0')  /* decimal part not zero */
         return NULL ;  

   if (fdescr.exp>9) 
      return NULL ; /* thus, a 32 bit integer should be sufficient */

   result = 0 ;
   for (i=0; i<fdescr.exp; i++)
      result = result * 10 + (fdescr.num[i]-'0') ;

   if (fdescr.negative)
      result = -result ;

   return &result ;
}
