//------------------------------------------------------------------------
//  EXP_ANAL.CPP
//  Keith Larson
//  TMS320 DSP Applications
// (c) Copyright 1995, 1996, 1997
// Texas Instruments Incorporated
//
// This is unsupported freeware code with no implied warranties or
// liabilities.  See the disclaimer document for details
//------------------------------------------------------------------------
//   The parser / expression analyzer this file has been derived from
//   the reference material listed below.  Features added include
//   a number format analyzer covering additional number formats,
//   strings, constant chars, Symbol tables, fixed/float types,
//   transcendental, logical, relational and assembler relative addressing
//
//   Title:     C: The Complete Reference
//   Author:    Herbert Schildt
//   Publisher: Osborne McGraw-Hill
//              ISBN 0-07-881538-X
//------------------------------------------------------------------------
#include <stdlib.h>
#include <ctype.h>
//#include <conio.h>
#include <stdio.h>
#include <string.h>
#include <math.h>
#include <signal.h>
#include "assm_fun.h"
#include "typedefs.h"
#include "tmsfloat.h"
#include "errormsg.h"
#include "symbols.h"
#include "argsplit.h"

NUM_TYPE ascii_num(char *ptr, long *binv);  // No header is set up for *.CPP
NUM_TYPE eval_exp1(NUM_TYPE numtype); // assignment
NUM_TYPE eval_exp2(NUM_TYPE numtype); // functions        sin,cos,tan...
NUM_TYPE eval_exp3(NUM_TYPE numtype); // relational       >,<,=
NUM_TYPE eval_exp4(NUM_TYPE numtype); // add/subtract     +,-
NUM_TYPE eval_exp5(NUM_TYPE numtype); // mul/divide       *,/,%
NUM_TYPE eval_exp6(NUM_TYPE numtype); // Boolean          &,|,^
NUM_TYPE eval_exp7(NUM_TYPE numtype); // Unary modifiers  +/-
NUM_TYPE eval_exp8(NUM_TYPE numtype); // paranthetical
NUM_TYPE atom     (NUM_TYPE numtype);

void putback(void);
void get_token(void);
int  isdelim(char c);

char   progbuf[120];         // global copy of input string
char   *prog;                // pointer to global copy of input string
char   token[80];            // global copy of the current token
char   tok_type = NOTOK;     // global tok_type starts without a type
double dbl_answer  = 0.0;    // Float intermediate return
long   long_answer =   0;    // Long intermediate return
char   NON_COFF_MATH_F = 0;  // Non COFF math functions have been used flag

char *C3XRegx[] =
{
  "F0" ,  "F1" ,  "F2" ,  "F3" ,  "F4" ,  "F5" ,  "F6" ,  "F7" ,
  "R0" ,  "R1" ,  "R2" ,  "R3" ,  "R4" ,  "R5" ,  "R6" ,  "R7" ,
  "AR0",  "AR1",  "AR2",  "AR3",  "AR4",  "AR5",  "AR6",  "AR7",
  "DP" ,  "IR0",  "IR1",  "BK" ,  "SP" ,  "ST" ,  "IE" ,  "IF" ,
  "IOF",  "RS" ,  "RE" ,  "RC" ,  "PC"
};
//-----------------------------------------------------------
// isreg2() tests an upper or lower case string to see if
// the string is an exact match to a register name.  On
// success returns a positive number whose offset-1 is the
// register.  On failure returns 0.
//--------------------------------------------------------
int isreg2(char *ptr)
{ char buf[bufsize];
  strncpy(buf,ptr,bufsize-1);
  ptr = buf;
  strupr(buf);
  int x;
  for(x=0;x<37;x++)
  { if(strexact(C3XRegx[x], ptr))
      return(x+1);
  }
  return 0;
}
//------------------------------------------------------
// enumerated strings of the functions linked into the
// expression analyzer make the code more readable
//------------------------------------------------------
enum FUNTYPES
{
  no_func = 0,
  f_abs  , f_acos , f_asin , f_atan , f_ceil ,
  f_cos  , f_cosh , f_exp  , f_fabs , f_floor,
  f_labs , f_log  , f_log10, f_pow10,
  f_sin  , f_sinh , f_sqrt , f_tan  , f_tanh ,
  // Extra functions
  f_pow,   // pow is used since ^ is used for XOR
  f_log2,
  f_btrv,
  f_circ,
  f_sfloat,  // 4/1/11
  f_float,   // 8/1/23 format
  f_float8, // 4/1/3 format
  f_float16, // 8/1/7 format
  f_ieee,    // 1/8/23 IEEE format
  f_rand,
  f_srand
};
//---------------------------------------------------
// func_type() returns the enumerated function value
// if an exact match is found and 'no_func' if not.
//---------------------------------------------------
int func_type(char *p)
{
  char cpy[20];
  // math.h functions
  strncpy(cpy,p,16);
  strlwr(cpy);
  p = cpy;
  if(strexact("abs"   ,p)) return f_abs;
  if(strexact("acos"  ,p)) return f_acos;
  if(strexact("asin"  ,p)) return f_asin;
  if(strexact("atan"  ,p)) return f_atan;
  if(strexact("ceil"  ,p)) return f_ceil;
  if(strexact("cos"   ,p)) return f_cos;
  if(strexact("cosh"  ,p)) return f_cosh;
  if(strexact("exp"   ,p)) return f_exp;
  if(strexact("fabs"  ,p)) return f_fabs;
  if(strexact("floor" ,p)) return f_floor;
  if(strexact("labs"  ,p)) return f_labs;
  if(strexact("log"   ,p)) return f_log;
  if(strexact("log10" ,p)) return f_log10;
  if(strexact("pow10" ,p)) return f_pow10;
  if(strexact("sin"   ,p)) return f_sin;
  if(strexact("sinh"  ,p)) return f_sinh;
  if(strexact("sqrt"  ,p)) return f_sqrt;
  if(strexact("tan"   ,p)) return f_tan;
  if(strexact("tanh"  ,p)) return f_tanh;
  // Extra functions
  if(strexact("pow"    ,p)) return f_pow;
  if(strexact("log2"   ,p)) return f_log2;
  if(strexact("br"     ,p)) return f_btrv;   // bit rev n Lsb of expression
  if(strexact("circ"   ,p)) return f_circ;   // adj to nearest circ boundary
  if(strexact("sfloat" ,p)) return f_sfloat; // 4/1/11 float
  if(strexact("float"  ,p)) return f_float;  // 8/1/23 float
  if(strexact("float8" ,p)) return f_float8; // 4/1/3 float
  if(strexact("float16",p)) return f_float16;// 8/1/7 float
  if(strexact("ieee"   ,p)) return f_ieee;   // 8/1/7 float
  if(strexact("rand"   ,p)) return f_rand;   // Random number generator
  if(strexact("srand"  ,p)) return f_srand;  // seeded version
  return no_func;
}
//-------------------------------------------------------------------
// dbl2lng() saturates (tests bounds) double floats into valid longs
//-------------------------------------------------------------------
long dbl2lng(double f)
{
  double ft;
  ft = 0x7FFFFFFFL;
  if(f > ft) return 0x7FFFFFFFL;
  ft = 0x80000000L;  // Borland treats this as unsigned
  if(f < -ft) return 0x80000000L;
  //chi return f;
  return (long)f;
}
//-------------------------------------------------------------------
// bitrev() performs modulo N bit reversal (see C3x UG for details)
//-------------------------------------------------------------------
ulong bitrev(ulong addr, ulong N)
{
  ulong t2,addr2;
  // check to see if power of 2
  //
  t2 = N ^ 0xFFFFFFFFL;  // 1's compliment
  // add should yield all 1's
  if(N + t2 != 0xFFFFFFFFL) return 0;
  t2 = 1;
  addr2 = addr & ( -N);  // Mask sets lower bits = 0
  //
  for(;N>0;)  // Bit reverse the LSB's
  {
    N>>=1;
    if(addr & N)
      addr2 |= t2;
    t2 = t2 << 1;
  }
  return addr2;
}
//------------------------------------------------------------
// powint() is used when both arguments are integers.  This
// allows some special cases (neg values) and minimizes
// potential bit level accuracy errors
//------------------------------------------------------------
long powint(long ltemp1, long ltemp2)
{
  long ltemp3;
  if(ltemp2 == 0) return 1; // N^0 return is always 1
  if(ltemp1 == 1) return 1; // 1^B return is always 1
  //
  // For -1^B, return is either 1 or -1
  if(ltemp1 == -1)
  { if(ltemp2 & 1) return -1; // odd pwrs of -1 return -1
    else           return  1; // -1^2,-1^4... return 1
  }
  //  A^-B  == 1/(A^B), therefor for ints always 0 (1/2, 1/3 all = 0)
  // case for 0^-B returns +MAX ... equivelent to (1/0)^B
  // case for 0^+B returns 0    (B is non-zero)
  if(ltemp2 < 1)
  { if(ltemp1 == 0) return 0x7fffffffL;
    else            return          0L;
  }
  // If A^BIG only the sign of A is relavent (-1,0,1 are already done)
  if(ltemp2 > 32) // Out is -BIG or +BIG
  { if((ltemp1 < 0) && (ltemp2 & 1)) return 0x80000000L; // max negative
    else                             return 0x7FFFFFFFL; // max positive
  }
  // Leftover is sequence of A*A*A*A calculated B times using int math
  // to preserve the integer value (long double can return an error!)
  ltemp3 = ltemp1;
  for(; ltemp2>1 ;--ltemp2)  ltemp3 = ltemp3 * ltemp1;
  return ltemp3;
}
double powflt(double f1, double f2)
{
  // Note: no special cases are written for for NAN, +BIG, -BIG
  return pow(f1,f2);
}
//----------------------------------------------------------
// non_symetric() tests a string for () pairs, returns 0
// if properly paired, and 1 if not.
//----------------------------------------------------------
int non_symetric(char *p)
{
  int par_lvl = 0;
  char *c;
  for(;;)
  {
    if(*p==   0) break;
    if(*p=='(' ) par_lvl++;
    if(*p==')' ) par_lvl--;
    if(*p=='\'')              // String and char data
    {
      c = strstr(p+1,"'");
      if(c==NULL) return 1;
      p = c;
      if(*(c-1) == '\\')   // "'" character follows an escape, goto next
        p++;

    }
    if(par_lvl < 0) return 1;
    p++;
  }
  if(par_lvl) return 1;
  return 0;
}
double clip_gte_0(double x) // -x clip for log and other functions
{
  if(x<=0.0)
  {
    assm_error_msg(range_warn,"");
    return 1e-64;
  }
  return x;
}
double clip_gt_0(double x) // -x clip for sqrt and other functions
{
  if(x<0.0)
  {
    assm_error_msg(range_warn,"");
    return 1e-64;
  }
  return x;
}
//========================================================================
// This expression analyzer/parser accepts numeric,symbolic and
// transcendental function calls.  Transcendentals are recognized as
// function call and not symbols by the open parend immediately to the
// right of the function name.
//========================================================================
int function_parend = 0;
NUM_TYPE expressionzz(char *ptr, ulong *lval, NUM_TYPE numtype);

int   foo_last_ref;
char *foo_sym_ptr;

MSGS add_foo_sym(void)
{
  // When the expression analyzer is called, all symbols that are
  // used must already be defined.  The expression analyzer creates
  // temporary symbols (foo) but does not create new symbols.  The
  // foo symbols can be removed by rolling back the various pointers.
  //
  foo_sym_ptr  = symbol_ptr; // save the symbol table string point
  foo_last_ref = last_ref  ; // save the last reference
  return NO_ERR;
}
MSGS remove_foo_sym(void)
{
  symbol_ptr = foo_sym_ptr; // restore the symbol table string point
  last_ref   = foo_last_ref;    // restore the last reference
  *symbol_ptr = 0;
  return NO_ERR;
}

NUM_TYPE expressionz(char *ptr, ulong *lval, NUM_TYPE numtype)
{
  MSGS err;
  char s1[120], s2[120], s3[120];
  char *c, *s, tmp;
  NUM_TYPE e;
  ulong foo;
  int x;
  int foonum=0;
  char foostrg[16];
  //
  // Identify and evaluate subexpressions
  //
  //  A*((1+2)+3)/4     = A*(foo1+3)/4 = A*foo1/4
  //  A*func(B)/4       = A*foo1/4
  //  A*func(B)+func(C) = A*func(B)+foo1 = A * foo2 + foo1
  //
  // Add all Foo symbols if not yet defined
  //
  add_foo_sym();
  strcpy(s1,ptr);
  for(int t=0;t<20;t++)
  { if(strstr(s1,"(")==NULL) break;
    s = s1;
    c = NULL;
    for(x=0;x<20;x++)
    { s = strstr(s,"(");
      if(s == NULL) break;  // Exit if no '('
      c = s;                // Remember last '('
      s++;
    }
    // If a '()' pair is found, it could be part of a function.  In this
    // case the () will be preceded by a character.  All other math
    // operators are non-char.  If a function(xxx), evaluate xxx
    if(c!=NULL)
    { for(;;)
      { if(c==NULL) break;
        if(c<=s1  ) break;
        c--;
        if(isalpha(*c)) // If this is a function(), evaluate with () intact
        {
          while(isalpha(*c)&&(c>=s1)) c--;
          c++;
          strcpy(s3,c);
          s = strstr(s3,")");
          s++;
          tmp = *s;
          *s=0;
          e = expressionzz(s3 , &foo, numtype);
          if(e==NOREF)
          {
            remove_foo_sym();
            return NOREF;
          }
          sprintf(foostrg,"_$x$_%d",foonum++);
          err=xref_add(foostrg,foo,e,SYM_FOO);
          if(err != NO_ERR)
          {
            remove_foo_sym();
            return NOREF;
          }
          *s = tmp;
          *c = 0;
          strcpy(s2,s1);
          strcat(s2,foostrg);
          strcat(s2,s);
          strcpy(s1,s2);
          //
          // Goto last '('
          //
          s = s1;
          c = NULL;
          for(x=0;x<20;x++)
          {
            s = strstr(s,"(");
            if(s == NULL) break;  // Exit if no '('
            c = s;                // Remember last '('
            s++;
          }
        }
        else
        { c++;
          break;
        }
      }
    }
    if(c==NULL) break;
    //
    // Find matching ')' and then terminate
    //
    s = strstr(c,")");
    *s=0;
    strcpy(s3,c+1);
    e = expressionzz(s3 , &foo, numtype);
    if(e==NO_REF)
    {
      remove_foo_sym();
      return NOREF;
    }
    //
    // Add foo[] for this () pair
    //
    sprintf(foostrg,"_$x$_%d",foonum++);
    err=xref_add(foostrg,foo,e,SYM_FOO);
    if(err != NO_ERR)
    {
      remove_foo_sym();
      return NOREF;
    }
    *c = 0;
    strcpy(s2,s1);
    strcat(s2,foostrg);
    strcat(s2,s+1);
    strcpy(s1,s2);
  }
  e = expressionzz(s1 , lval, numtype);
  //
  // Delete _$x$_%d temp variables from symbol table
  //
  remove_foo_sym();
  return e;
}

NUM_TYPE expressionzz(char *ptr, ulong *lval, NUM_TYPE numtype)
{
  float f;
  NUM_TYPE rtype;
  //chi char ttoken=0;
  function_parend = 0;
  strncpy(progbuf,ptr,119);
  prog = progbuf;
  //
  // evaluate the string for (()) symetry at this level.
  // checking at lower levels is not required
  //
  if(non_symetric(prog))
  { assm_error_msg(x_ubalance,"");
    return numtype;      // further errors are ignored
  }
  get_token();


  //--------------------------------------------------------------
  // Install the FPE catcher each time the exp analyzer is called
  //--------------------------------------------------------------
  //signal(SIGFPE, (fptr)Catcher);  // Install FP error catcher
  //--------------------------------------------------------------
  if(!*token)  return NOREF; //x_noexp;
  rtype = eval_exp1(AUTO);  // All expressions are AUTO analyzed
  //
  // If the return 'rtype' is AUTO or NOREF an error has occurred
  if((rtype != INTEGER) &&  (rtype != FLOAT))
  { if(g_pass>1)
    {
      // Since .sdefine'd directives are anihilated at the end
      // of pass1, the .ifdef directive will generate NOREF errors
      // until the symbol is redefined.  The most convenient place
      // to trap and fix this 'non-error' being here.
      //
      if(strstr(arg[1].s,".ifdef") != NULL)
      {
        assm_error_msg(UNKN_EXPR,ptr); // This will create an error
        return numtype;
      }
    }
    return rtype;
  }
  //  numtype  rtype
  //
  //  INTEGER: dontcare  return INTEGER
  //    FLOAT: dontcare  return FLOAT
  //     AUTO: INTEGER   return INTEGER
  //     AUTO: FLOAT     return FLOAT
  //
  if(numtype==AUTO) numtype = rtype;
  switch(numtype)
  {
    case INTEGER: *lval = long_answer;
                  break;
    case FLOAT  : f = dbl_answer;
                  *lval = *((long *)&f);
                  break;
    case AUTO   : // rtype = rtype;  // Never happens
    default     : return NOREF;      // Never happens
  }
  return numtype;
}
//
// process an assignment
//

NUM_TYPE eval_exp1(NUM_TYPE numtype)
{
  NUM_TYPE rtype;
//char ttok_type;
//char temp_token[80];
  //
  // Assignment operations are not supported by the expression analyzer
  // at this time, but would otherwise go here... This is where a C
  // expression or algebraic analyzer would most likely fit.
  //
/*if((tok_type==VARIABLE)||(tok_type==FUNCTION))
  {
    strcpy(temp_token,token);    // save old token
    ttok_type = tok_type;
    get_token();
    //
    switch(*token)
    {
      case '=': break;           // Asignment operator
      default:                   // Regular expression analysis
      putback();                 // return current token
      strcpy(token, temp_token); // restore old token - not assignment
      tok_type = ttok_type;
    }
  }*/
  rtype = eval_exp3(numtype);
  return rtype;
}
//------------------------------------------------------
// fast 32 bit random number generator
//------------------------------------------------------
unsigned long RAND_SEED = 0;
unsigned long srand86(unsigned long A)
{
  #define C1 0x107465
  #define C2 0x234567
  A *= 0x107465L;
  A += 0x234567L;
  RAND_SEED = A;
  return(A);
}
unsigned long rand86(void)
{
  return srand86(RAND_SEED);
}
//------------------------------------------------------
// Math and other function call processing
//------------------------------------------------------
NUM_TYPE eval_expF(NUM_TYPE numtype)
{
  NUM_TYPE rtype,ttype;
  int func;
  NUM_TYPE rtype2;
  long   ltemp;
  float f;
  double dtemp;
  //
  // possible start of function call
  // avoid false start from string and char
  //
  if((*prog=='(')&&(*token!='(')&&(*token!='\'')&&(*token!='"'))
  {
    func = func_type(token);
    if(func == no_func) return NOREF; // unknown functions are errors!
    NON_COFF_MATH_F = 1;    // Set non-COFF flag
    get_token();
    //
    function_parend = 1; // original
//  function_parend = 0; // 4/20/96
    //
    // Functions with void input
    //
    if(func == f_rand)
    {
      if(*token!='(') return NOREF;
      get_token();
      if(*token!=')') return NOREF;
      long_answer= rand86();
      dbl_answer =(double)long_answer/(double)0x7FFFFFFFL;
      if(numtype == AUTO)  return FLOAT;
      return numtype;
    }
    else
      rtype = eval_exp1(AUTO);  // eval func(exp) without trailers

    //
    // Multi-element function tokens should be ','
    // All others should be fully analyzed and either
    // terminated '0' or ')'
    //
    switch(*token)
    {
      case   0 : break;
      case  ')': break;
      case  ',': if(func==f_btrv) break;
                 if(func==f_circ) break;
                 if(func==f_pow)  break;
      default  : assm_error_msg(x_syntax,"");
                 break;
    }
    function_parend = 0;

    if(*token != ',') get_token(); // dont chop off 2nd operand to func

    if((rtype != INTEGER) && (rtype != FLOAT)) return rtype;
    if(func != f_pow)
    {
      rtype   = FLOAT;
      numtype = FLOAT;
    }

    switch(func)
    {

      case f_srand:long_answer= srand86 (long_answer);
                   dbl_answer =(double)long_answer/(double)0x7FFFFFFFL;
                   if(numtype == AUTO)  return FLOAT;
                   return numtype;

      default     : break;
    }

    switch(func)
    {
      // These functions all use double precision float
      //chi case f_abs  : dbl_answer = abs  (dbl_answer); break;
      case f_abs  : dbl_answer = abs  ((int)dbl_answer); break;
      case f_acos : dbl_answer = acos (dbl_answer); break;
      case f_asin : dbl_answer = asin (dbl_answer); break;
      case f_atan : dbl_answer = atan (dbl_answer); break;
      case f_ceil : dbl_answer = ceil (dbl_answer); break;
      case f_cos  : dbl_answer = cos  (dbl_answer); break;
      case f_cosh : dbl_answer = cosh (dbl_answer); break;

      case f_exp  :
                    dbl_answer = exp  (dbl_answer); break;

      case f_fabs : dbl_answer = fabs (dbl_answer); break;
      case f_floor: dbl_answer = floor(dbl_answer); break;
      //chi case f_labs : dbl_answer = labs (dbl_answer); break;
      case f_labs : dbl_answer = labs ((long int)dbl_answer); break;
      case f_log  : //dbl_answer = clip_gte_0(dbl_answer);
                    dbl_answer = log  (dbl_answer); break;
      case f_log10: //dbl_answer = clip_gte_0(dbl_answer);
                    dbl_answer = log10(dbl_answer); break;
      //chi case f_pow10: dbl_answer = pow10(dbl_answer); break;
      case f_pow10: dbl_answer = pow(10,dbl_answer); break;
      case f_sin  : dbl_answer = sin  (dbl_answer); break;
      case f_sinh : dbl_answer = sinh (dbl_answer); break;
      case f_sqrt : //if(rtype==INTEGER) intsqrt(long_answer)
                    //else
                  //  dbl_answer = clip_gt_0(dbl_answer);
                    dbl_answer = sqrt (dbl_answer); break;
      case f_tan  : dbl_answer = tan  (dbl_answer); break;
      case f_tanh : dbl_answer = tanh (dbl_answer); break;
      //--------------------------------------------------------
      // Additional functions that are not in <math.h>
      case f_log2 : //dbl_answer = clip_gte_0(dbl_answer);
                    dbl_answer = log(dbl_answer)/log(2.0); break;
      //--------------------------------------------------------
      case f_btrv :
      case f_circ : ltemp = long_answer;// keep first value
                    if(*token != ',') return NOREF; //return MISS_ARG;
                    get_token();
                    rtype2 = eval_exp1(INTEGER); // convert 2nd argument
                    if(*token == ')')
                      get_token();
                    if(rtype2!=INTEGER) return rtype2;

                    long_answer = bitrev(ltemp,long_answer);
                    dbl_answer = long_answer;
                    return INTEGER;
     //---------------------------------------------------------
     // Return a 16 bit short float as an integer for shifting etc...
     // 4/1/11 format
     case f_sfloat: long_answer = TMS_TMS_SHORT(IEEE_TMS(dbl_answer));
                    return INTEGER;
     // 8/1/23 format
     case f_float:  long_answer = IEEE_TMS(dbl_answer);
                    return INTEGER;
     // 4/1/3 format
     case f_float8: long_answer = TMS_C3X_VSHORT(IEEE_TMS(dbl_answer));
                    return INTEGER;
     // 8/1/7 format
     case f_float16:long_answer = TMS_C32_16(IEEE_TMS(dbl_answer));
                    return INTEGER;
     // 1/8/23 IEEE format
     case f_ieee   :f = dbl_answer;
                    long_answer = *((long *)&f);
                    return INTEGER;
     //---------------------------------------------------------
     // double pow(double,double) is rewritten to include
     // support for integers and negative coefficents
      case f_pow :
                    ltemp = long_answer;  // keep first value
                    dtemp = dbl_answer;
                    ttype = rtype;

                    if(*token!=',') return NOREF; //return MISS_ARG;
                    get_token(); // get , seperator

                    rtype = eval_exp1(AUTO); // convert 2nd argument
                    if((ttype == INTEGER) & (rtype == INTEGER))
                    { long_answer = powint(ltemp,long_answer);
                      dbl_answer = long_answer;
                      return INTEGER;
                    }
                    else
                    {
                      if((ttype == NOREF)||(rtype == NOREF)) return NOREF;
                      if(dbl_answer >= 0.0)
                      {
                        if(dtemp==0.0) dbl_answer = 1.0;
                        else           dbl_answer  = pow(dtemp,dbl_answer);
                      }
                      else
                      {
                        if(dtemp==0.0) dbl_answer = MAX_FLOAT;
                        else      dbl_answer  = 1.0/pow(dtemp,-dbl_answer);
                      }
                      if(dbl_answer > MAX_FLOAT) dbl_answer = MAX_FLOAT;
                      if(dbl_answer < MIN_FLOAT) dbl_answer = MIN_FLOAT;
                      // Make sure that the value assigned to long_answer
                      // will fit in the range of a long.  If not an error
                      // would result
                      long_answer = dbl2lng(dbl_answer);
                      return FLOAT;
                    }
     //---------------------------------------------------------
      default   : return NOREF;  // should never get here
    }
    //chi long_answer = dbl_answer;
    long_answer = (long int)dbl_answer;
    if(numtype == AUTO)  return FLOAT;
    return numtype;
  }
  else
  {
    // If there is nothing left to analyze an error may have
    // occured.
    //
    // Example    .word pow         ;where pow  is a label
    //            .word pow(2,pow)  ;where pow2 is a label
    //
    switch(*prog)
    {
      case   0:
      case ')':
      case ',': return      atom(numtype); // try table lookup
      default : return eval_exp3(numtype); // evaluate whats left
    }
  }
}
//------------------------------------------------------
// relational operations <,>,==, and bit shift << >>
//------------------------------------------------------
NUM_TYPE eval_exp3(NUM_TYPE numtype)
{
  char op;
  NUM_TYPE rtype,ttype;
  int equal_flag=0;
  double dtemp, ddtemp;
  long   ltemp, lltemp;
  ttype = eval_exp4(numtype);
  if((ttype != INTEGER) &&  (ttype != FLOAT)) return ttype;
  rtype = ttype;
  while((op = *token)=='>' || op=='<' || op=='=' || op=='!')
  {
    if(op=='=')
    {
      switch(*prog)
      {
        case '!':
        case '<':
        case '>': return NOREF; // =< => =! are illegal
        default : break;
      }
    }
    dtemp = dbl_answer;
    ltemp = long_answer;
    get_token();
    if((op=='!') && (*token != '='))
    {
      putback();    // putback the original token and pass
      return NOREF; // control to another analyzer module
    }
    if(*token == '=')  // perform both compare and equal to operations
    {
      if(op=='!') { get_token(); op = 'N';}
      else        { get_token(); equal_flag = 1;} // discard '=' token
    }
    if(*token == op) // operation is actually bit shift
    {
      get_token();
      if(op == '>') op = 'R';
      if(op == '<') op = 'L';
//    numtype = INTEGER;
    }
    if((op=='<') && (*token == '>'))
    {
      get_token();
      op = 'N';
    }
    rtype = eval_exp5(numtype);
    if(rtype == NOREF) return NOREF;
    // Operate on both type pairs
    lltemp = long_answer;
    ddtemp = dbl_answer;
    switch(op)
    {
    case '>': if(dtemp > dbl_answer ) dbl_answer = 1.0; else  dbl_answer=0.0;
              if(ltemp > long_answer) long_answer =  1; else long_answer=  0;
              break;
    case '<': if(dtemp < dbl_answer ) dbl_answer = 1.0; else  dbl_answer=0.0;
              if(ltemp < long_answer) long_answer =  1; else long_answer=  0;
              break;
    case '=': if(dtemp == dbl_answer ) dbl_answer = 1.0; else  dbl_answer=0.0;
              if(ltemp == long_answer) long_answer =  1; else long_answer=  0;
              break;
    case 'R': if(long_answer >  32) {ltemp = 0; long_answer = 0;}
              if(long_answer < -32) {ltemp = 0; long_answer = 0;}
              long_answer = ltemp >> long_answer;
              dbl_answer = long_answer;
              break;
    case 'L': if(long_answer >  32) {ltemp = 0; long_answer = 0;}
              if(long_answer < -32) {ltemp = 0; long_answer = 0;}
              long_answer = ltemp << long_answer;
              dbl_answer = long_answer;
              break;
    case 'N': if(dtemp != dbl_answer ) dbl_answer = 1.0; else  dbl_answer=0.0;
              if(ltemp != long_answer) long_answer =  1; else long_answer=  0;
              break;
    }
    if(equal_flag)
    {
      if(dtemp == ddtemp ) dbl_answer = 1.0;
      if(ltemp == lltemp ) long_answer =  1;
    }
    // If either relational operator operands are FLOAT
    // the correct answer is in dbl_answer and needs to be
    // copied to long_answer (.if uses long_answer)
    //
    if((ttype == FLOAT)||(rtype == FLOAT))
      //chi long_answer = dbl_answer;
      long_answer = (long int)dbl_answer;
  }
  // Decide which type to return
  switch(ttype)
  { case FLOAT:   rtype = FLOAT; break;
    case INTEGER:                break;
    default:      rtype = NOREF; break;
  }
  return rtype;
}
//------------------------------------------------------
// add or subtract two terms
//------------------------------------------------------
NUM_TYPE eval_exp4(NUM_TYPE numtype)
{
  char op;
  NUM_TYPE rtype,ttype;
  double dtemp;
  long   ltemp;
  ttype = eval_exp5(numtype);
  if((ttype != INTEGER) &&  (ttype != FLOAT)) return ttype;
  rtype = ttype;
  while((op = *token) == '+' || op == '-')
  { get_token();
    dtemp = dbl_answer;
    ltemp = long_answer;
    rtype = eval_exp5(numtype);  // evaluate next logical group of ops
    if(rtype == NOREF) return NOREF;
    // Operate on both type pairs
    switch(op)
    { case '-': dbl_answer = dtemp - dbl_answer;
                long_answer= ltemp -long_answer; break;
      case '+': dbl_answer = dtemp + dbl_answer;
                long_answer= ltemp +long_answer; break;
    }
    // Decide which type to return
    switch(ttype)
    { case FLOAT:   rtype = FLOAT; break;
      case INTEGER: rtype = rtype; break;
      default:      rtype = NOREF; break;
    }
  }
  return rtype;
}
//------------------------------------------------------
// Multiply or divide two factors
//------------------------------------------------------
NUM_TYPE eval_exp5(NUM_TYPE numtype)
{ char op;
  NUM_TYPE rtype,ttype;
  double dtemp;
  long ltemp;
  ttype = eval_exp6(numtype);
  if((ttype != INTEGER) &&  (ttype != FLOAT)) return ttype;
  rtype = ttype;
  while((op = *token) == '*' || op == '/' || op == '%')
  { get_token();
    dtemp = dbl_answer;
    ltemp = long_answer;
    rtype = eval_exp6(numtype);  // evaluate next logical group of ops

    if(rtype == NOREF) return NOREF;
    switch(op)
    { case '*': dbl_answer = dtemp * dbl_answer;
                long_answer= ltemp * long_answer; break;
      case '/':

                if((rtype == FLOAT)|| (ttype == FLOAT)) // Use float
                {
                  if(dbl_answer == 0.0) // Denominator is zero
                  {
                    if(dtemp>0)
                    { dbl_answer  =  1.0e128;
                      long_answer = 0x7FFFFFFFL;
                    }
                    else
                    { dbl_answer  = -1.0e128;
                      long_answer = 0x80000000L;
                    }
                  }
                  else
                    dbl_answer = dtemp / dbl_answer;
                }
                else  // Use long integer divide
                {
                  if(long_answer == 0.0) // Denominator is zero
                  {
                    if(ltemp>0) long_answer  = 0x7FFFFFFFL;
                    else        long_answer  = 0x80000000L;
                  }
                  else
                    long_answer= ltemp / long_answer;
                  dbl_answer = long_answer;
                }
                break;
      case '%': dbl_answer = (long)dtemp % (long)dbl_answer;
                long_answer= ltemp % long_answer; break;
    }
    //
    // In cases where either rtype is float, the integer operands may not
    // be correct (zero) and should therefor not used
    //
    if((rtype == FLOAT)||(ttype == FLOAT))
    {
      dtemp = dbl_answer;
      if(dtemp >  0x7FFFFFFFL) dtemp =  0x7FFFFFFFL;
      if(dtemp < -0x7FFFFFFFL) dtemp = -0x7FFFFFFFL;
      //chi long_answer = dtemp;
      long_answer = (long int)dtemp;
    }
    switch(ttype)
    { case FLOAT:   rtype = FLOAT; break;
      case INTEGER: rtype = rtype; break;
      default:      rtype = NOREF; break;
    }
  }
  return rtype;
}
//----------------------------------------------------
// Process boolean operators
//----------------------------------------------------
NUM_TYPE eval_exp6(NUM_TYPE numtype)
{
  char op;
  NUM_TYPE rtype,ttype;
  long ltemp;
  ttype = eval_exp7(numtype);
  if((ttype != INTEGER) && (ttype!=FLOAT)) return ttype;
  rtype = ttype;

  while((op = *token) == '&' || op == '|' || op == '^')
  {
    get_token();
    ltemp = long_answer;
    rtype = eval_exp7(INTEGER);
    if(rtype == NOREF) return NOREF;
    switch(op)
    { case '&': long_answer= ltemp & long_answer; break;
      case '|': long_answer= ltemp | long_answer; break;
      case '^': long_answer= ltemp ^ long_answer; break;
    }
    dbl_answer = long_answer;
    switch(ttype)
    { case FLOAT:   rtype = FLOAT; break;
      case INTEGER: rtype = rtype; break;
      default:      rtype = NOREF; break;
    }
  }
  return rtype;
}
//----------------------------------------------------
// Evaluate a unary +,-,~,!
//----------------------------------------------------
NUM_TYPE eval_exp7(NUM_TYPE numtype)
{
  char op = 0;
  NUM_TYPE rtype;
  int ttype;
  if(tok_type==DELIMITER)
  {
    op = *token;
    if(op=='!' || op=='~' || op=='+' || op =='-')
    {
      get_token();
      ttype = tok_type;
      rtype = eval_exp7(numtype); // eval nxt group if higher precedence
      tok_type =  ttype;
      switch(op)
      {
        case '-': long_answer = -long_answer;
                  dbl_answer  = -dbl_answer;
                  break;
        case '!': if(long_answer ==  0) long_answer = 1; // Logical NOT
                  else                  long_answer = 0;
                  if(dbl_answer  ==0.0) dbl_answer = 1;
                  else                  dbl_answer = 0;
                  break;
        case '~': long_answer = ~long_answer;            // 1's compliment
                  dbl_answer = long_answer;
        case '+': break;
        default : break;
      }
      return rtype;
    }
  }
  rtype = eval_exp8(numtype); // eval nxt group if higher precedence
  return rtype; // If token is not DELIMITER return
}
//----------------------------------------------------
// Process a parenthized expression
//----------------------------------------------------
NUM_TYPE eval_exp8(NUM_TYPE numtype)
{
  NUM_TYPE rtype;
  int tfp;
  if((*token == '('))
  {
    get_token();
    rtype = eval_exp1(numtype);
    if(*token != ')')
    {
       if(*token == ',') return rtype;
       putback();
       return rtype;
    }
    if(function_parend == 0)
    get_token();
  }
  else
  {
    if(tok_type==FUNCTION)
    {
      if(*prog != '(')
         return atom(numtype); // not a proper function!  maybe symbol?
      tfp = function_parend;
      function_parend = 0;
      rtype = eval_expF(numtype);
      function_parend = tfp;
    }
    else                   rtype = atom(numtype);
  }
  return rtype;
}
//----------------------------------------------------
// turn numeric strings into real numbers
//----------------------------------------------------
NUM_TYPE atom(NUM_TYPE numtype)
{ long value;
  long_answer = 0;
  dbl_answer = 0.0;
  switch(tok_type)
  { case VARIABLE:
    case FUNCTION:
    case NUMBER: if(*token == '$')
                 {
                   if(strexact(token,"$")==0)
                     return NOREF;
                   long_answer = SEG[current_seg].offs; // SPC
                   dbl_answer  = SEG[current_seg].offs; // SPC
                   get_token();
                   return INTEGER;
                 }
                 if(*token == '\'')
                 {
                   if(*prog != 0)  // Special case for delimeters
                   {               // where char is not contained
                                   // within 'token'
                     long_answer = *prog;        // Convert character
                     dbl_answer  = long_answer;
                     prog++;                     // Move past character
                     get_token();                // Initialize next token
                     return INTEGER;
                   }
                 }
                 switch(ascii_num(token, &value))
                 {
                   case FLOAT:  dbl_answer  = (double) *((float *)&value);
                                //
                                // Check range before assigning to long
                                // long_answer = dbl_answer;
                                long_answer = dbl2lng(dbl_answer);
                                if(numtype==AUTO) numtype = FLOAT;
                                break;

                   case INTEGER:long_answer = value;
			        dbl_answer = long_answer;
			        if(numtype==AUTO) numtype = INTEGER;
			        break;
		   default:     numtype = NOREF;  // Conversion error
	                        break;
                 }
    case DELIMITER:
    case NOTOK   :
    default      : break;  // DELIMITER, NOTOK & error
  }
  get_token();
  return numtype;
}
//----------------------------------------------------
// return a token to the input stream
//----------------------------------------------------
void putback(void)
{
  char *t;
  t = token;
  for(;*t;t++) prog--;
}

//----------------------------------------------------
// return the next token
//----------------------------------------------------
void get_token(void)
{
  char *temp;
  char buf[80];
  tok_type = 0;
  temp = token;
  *temp = 0;
  if(!*prog) return; // at end of expression
  while(isspace(*prog)) ++prog; // skip over WS
  if(strchr("+-*/%^=(),&|!~<>",*prog))
  {
    tok_type = DELIMITER;
    *temp++ = *prog++;    // advance to next char
  }
  else
  {
    if(isalpha(*prog) || *prog=='_')
    {
      while(!isdelim(*prog)) *temp++ = *prog++;
      *temp = 0;
      if(func_type(token) != no_func) tok_type = FUNCTION;
      else                            tok_type = VARIABLE;
    }
    else
    {
      if(isdigit(*prog) || (*prog=='.'))
      {
        while(!isdelim(*prog)) *temp++ = *prog++;
        tok_type = NUMBER;
      }
      else
      {
        if((*prog == '\'')||(*prog == '$')) // is char or PC relative
        {
          while(!isdelim(*prog))
            *temp++ = *prog++;
          tok_type = NUMBER;
        }
      }
    }
  }
  *temp = 0;
  //
  // If start of token is numeric, and end of token is 'e'
  // then the argument could be a floating point value
  // which the token analyzer has incorrectly split up
  //
  //    Ex: "1.75E-01" splits to token="1.75E" and prog="-01" -BAD-
  //        "1.75E+01" splits to token="1.75E" and prog="+01" -BAD-
  //        "1.75E01"  splits to token="1.75E01" and prog=""  -OK-
  //
  //    Hexdecimal numbers
  //        "0xABCDE-01" splits to token="0xABCDE" and prog="-01" -BAD-
  //        "0ABCDEh-01" splits to token="0ABCDEh" and prog="-01" -OK-
  //
  //
  //    Floating 'E' or exponents are compacted by the argument splitter
  //    before getting to the expression analyzer and are not a problem
  //        "1.75 E 01"  => "1.75E01"  which analyzes correctly
  //
  temp--;
  if(isdigit(*token)||(*token=='.'))
  {
    if((*temp=='e')||(*temp=='E'))  // 'E' is connected to x.xxxx
    {
      if(strstr(token,"0x")==NULL)
      {
        strncpy(buf,token,79);
        get_token();
        if((*token=='+')||(*token=='-'))// +- are unassociated free tokens
        {
          strncat(buf,token,79);
          get_token();                 // Next token should be a number
          if(isdigit(*token))
          {
            strncat(buf,token,79);
            get_token();
            strcpy(token,buf);
            tok_type = NUMBER;
          }
          else
           putback();
        }
        else
          putback();  // putback and return - someone else generates error!
      }
    }
  }
}
//----------------------------------------------------
// return true if c is a delimiter
//----------------------------------------------------
int isdelim(char c)
{
  if(strchr(" +-*/%^=(),&|!~<>",c) || c==9 || c=='\r' || c==0)
    return 1;
  return 0;
}

