/*	Copyright (C) 1990, 1992, 1993 Free Software Foundation, Inc.

This file is part of Oleo, the GNU Spreadsheet.

Oleo is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

Oleo 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 General Public License for more details.

You should have received a copy of the GNU General Public License
along with Oleo; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

#include <ctype.h>
#include <stdio.h>

#ifdef __TURBOC__
#define SMALLEVAL
#endif

#include "funcdef.h"

#define obstack_chunk_alloc ck_malloc
#define obstack_chunk_free free
#include "obstack.h"

#include "sysdef.h"
#include "global.h"
#include "cell.h"
#include "eval.h"
#include "errors.h"

#if defined(HAVE_RINT)
#ifdef __STDC__
extern double rint (double);
extern long random (void);
#else
extern double rint ();
extern long random ();
#endif
#else
#define rint(x) (((x)<0) ? ceil((x)-.5) : floor((x)+.5))
#endif



extern int n_usr_funs;




double to_int ();
static int deal_area ();
static void add_int ();
static void add_flt ();
#ifndef __TURBOC__
RETSIGTYPE math_sig ();
#endif

#ifdef __STDC__
int fls (long);
#else
int fls ();
#endif
#ifdef SMALLEVAL
int __to_flt (struct value *);
int __to_int (struct value *);
int __to_num (struct value *);
int __to_str (struct value *);
int __to_bol (struct value *);
int __to_rng (struct value *);
#endif



struct value
  {
    int type;
    union vals x;
  };

#define Float	x.c_d
#define String	x.c_s
#define Int	x.c_l
#define Value	x.c_i
#define Rng	x.c_r

#undef PI
#define PI (3.14159265358979326848)

static struct value *stack;
static int stackmax;
static int curstack;

unsigned short current_cycle;

CELLREF cur_row;
CELLREF cur_col;

static double exp10_arr[] =
{
  1E0, 1E1, 1E2, 1E3, 1E4,
  1E5, 1E6, 1E7, 1E8, 1E9,
  1E10, 1E11, 1E12, 1E13, 1E14,
  1E15, 1E16, 1E17, 1E18, 1E19,
  1E20, 1E21, 1E22, 1E23, 1E24,
  1E25, 1E26, 1E27, 1E28, 1E29
};

/* Various math conversions with error checking */
#define I_ADD(i1,i2) {	itmp=(i1)+(i2);					\
			if((i1>0)==(i2>0) && (itmp>0)!=(i1>0)) {	\
				p->Float=(double)(i1)+(double)(i2);	\
				p->type=TYP_FLT;			\
			} else						\
				p->Int=itmp;	}

#define I_SUB(i1,i2) {	itmp=(i1)-(i2);					\
			if(((i1)<0)==((i2)>0) && ((itmp)>0)!=((i2)<0)) {\
				p->Float=(double)(i1)-(double)(i2);	\
				p->type=TYP_FLT;			\
			} else						\
				p->Int=itmp;	}

#define I_DIV(i1,i2) {	ftmp=(double)(i1)/(double)(i2);			\
			/* ... */;					\
			p->Float=ftmp;					\
			p->type=TYP_FLT;	}

#define I_MOD(i1,i2) {itmp=(i1)%(i2);/* ... */;p->Int=itmp;}

#define I_MUL(i1,i2) {	if(fls(i1)+fls(i2)>32) {			\
				p->Float=(double)(i1)*(double)(i2);	\
				p->type=TYP_FLT;			\
			} else						\
				p->Int=(i1)*(i2);	}

#define F_ADD(f1,f2) {	ftmp=(f1)+(f2);/* ... */;p->Float=ftmp;	}

#define F_SUB(f1,f2) {	ftmp=(f1)-(f2);/* ... */;p->Float=ftmp;}

#define F_DIV(f1,f2) {	ftmp=(f1)/(f2);/* ... */;p->Float=ftmp;}

#define F_MOD(f1,f2) {	itmp=(long)(f1)%(long)(f2);/* ... */;p->Int=itmp;p->type=TYP_INT;}

#define F_MUL(f1,f2) {	ftmp=(f1)*(f2);/* ... */;p->Float=ftmp;}

double ftmp;
long itmp;
int overflow;

/* You may ask:  Why not jsut put the value in stack[0] and goto break_out
   The answer is that ERROR is a valid input type for several operators, so
   we want to work if we're feeding an error into one of these operators. . .
 */
#define ERROR(cause)		\
	{			\
		p->type=TYP_ERR;\
		p->Value=cause; \
		goto next_byte; \
	}

#ifdef SMALLEVAL

#define TO_FLT(val)			\
	if((tmp=__to_flt(val))!=0)	\
		ERROR(tmp);

#define TO_INT(val)			\
	if((tmp=__to_int(val))!=0)	\
		ERROR(tmp);

#define TO_NUM(val)			\
	if((tmp=__to_num(val))!=0)	\
		ERROR(tmp);

#define TO_STR(val)			\
	if((tmp=__to_str(val))!=0)	\
		ERROR(tmp);

#define TO_BOL(val)			\
	if((tmp=__to_bol(val))!=0)	\
		ERROR(tmp);

#define TO_RNG(val)			\
	if((tmp=__to_rng(val))!=0)	\
		ERROR(tmp);

#else
#define TO_FLT(val)	\
	if((val)->type==TYP_FLT) \
		; \
	else if((val)->type==TYP_INT) { \
		(val)->type=TYP_FLT; \
		(val)->Float=(double)(val)->Int; \
	} else if((val)->type==TYP_STR) { \
		(val)->type=TYP_FLT; \
		strptr=(val)->String; \
		(val)->Float=astof(&strptr); \
		if(*strptr) \
			ERROR(NON_NUMBER); \
	} else if((val)->type==TYP_ERR) {\
		ERROR((val)->Value); \
	} else if((val)->type==0) { \
		(val)->type=TYP_FLT; \
		(val)->Float=0.0; \
	} else \
		ERROR(NON_NUMBER);

#define TO_INT(val)	\
	if((val)->type==TYP_INT) \
		; \
	else if((val)->type==TYP_FLT) { \
		(val)->type=TYP_INT; \
		(val)->Int=(long)(val)->Float; \
	} else if((val)->type==TYP_STR) { \
		(val)->type=TYP_INT; \
		strptr=(val)->String; \
		(val)->Int=astol(&strptr); \
		if(*strptr) \
			ERROR(NON_NUMBER); \
	} else if((val)->type==TYP_ERR) {\
		ERROR((val)->Value); \
	} else if((val)->type==0) { \
		(val)->type=TYP_INT; \
		(val)->Int=0; \
	} else \
		ERROR(NON_NUMBER);

#define TO_NUM(val)	\
	if((val)->type==TYP_INT || (val)->type==TYP_FLT) \
		; \
	else if((val)->type==TYP_STR) { \
		(val)->type=TYP_FLT; \
		strptr=(val)->String; \
		(val)->Float=astof(&strptr); \
		if(*strptr) \
			ERROR(NON_NUMBER); \
	} else if((val)->type==TYP_ERR) {\
		ERROR((val)->Value); \
	} else if((val)->type==0) { \
		(val)->type=TYP_INT; \
		(val)->Int=0; \
	} else \
		ERROR(NON_NUMBER);

#define TO_STR(val)	\
	if((val)->type==TYP_STR)	\
		;	\
	else if((val)->type==TYP_INT) {	\
		char *s;	\
		(val)->type=TYP_STR;	\
		s=obstack_alloc(&tmp_mem,30); \
		sprintf(s,"%ld",(val)->Int); \
		(val)->String=s;	\
	} else if((val)->type==TYP_FLT) {		\
		char *s;				\
		s=flt_to_str((val)->Float);		\
		(void)obstack_grow(&tmp_mem,s,strlen(s)+1); \
		(val)->String=obstack_finish(&tmp_mem);	\
		(val)->type=TYP_STR;			\
	} else if((val)->type==TYP_ERR) {		\
		ERROR((val)->Value);	\
	} else if((val)->type==0) {	\
		(val)->type=TYP_STR;	\
		(val)->String=obstack_alloc(&tmp_mem,1); \
		(val)->String[0]='\0'; \
	} else \
		ERROR(NON_STRING);

#define TO_BOL(val)	\
	if((val)->type==TYP_BOL)	\
		;	\
	else if((val)->type==TYP_ERR) {	\
		ERROR((val)->Value);	\
	} else	\
		ERROR(NON_BOOL);


#define TO_RNG(val) \
	if((val)->type==TYP_RNG) \
		; \
	else if((val)->type==TYP_ERR) {\
		ERROR((val)->Value); \
	} else \
		ERROR(NON_RANGE);

#endif

#define TO_ANY(val) \
	if((val)->type==TYP_RNG) \
		ERROR(BAD_INPUT); \

#define PUSH_ANY(cp)				\
	if(!cp || !GET_TYP(cp)) {		\
		p->type=0;			\
		p->Int=0;			\
	} else {				\
		p->type=GET_TYP(cp);		\
		p->x=cp->c_z;			\
	}

void
init_eval ()
{
  stack = (struct value *) ck_malloc (20 * sizeof (struct value));
  stackmax = 20;
  curstack = 0;
  current_cycle++;
#ifndef __TURBOC__
  (void) signal (SIGFPE, math_sig);
#endif
}

/* This huge function takes a byte-compiled expression and executes it. */
struct value *
eval_expression (expr)
     unsigned char *expr;
{
  unsigned char byte;
  unsigned numarg;
  unsigned jumpto;
  struct function *f;
  struct value *p;
  char *strptr;
  int tmp;

  CELLREF lrow, hrow, crow;
  CELLREF lcol, hcol, ccol;

  struct cell *cell_ptr;

  if (!expr)
    return 0;
  jumpto = 0;
  numarg = 0;
  p = 0;
  curstack = 0;
  while ((byte = *expr++) != ENDCOMP)
    {
      if (byte < USR1)
	f = &the_funs[byte];
      else if (byte < SKIP)
	{
#ifdef TEST
	  if (byte - USR1 >= n_usr_funs)
	    panic ("Only have %d usr-function slots, but found byte for slot %d", n_usr_funs, 1 + byte - USR1);
#endif
	  tmp = *expr++;
	  f = &usr_funs[byte - USR1][tmp];
	}
      else
	f = &skip_funs[byte - SKIP];

      if (f->fn_argn & X_J)
	jumpto = *expr++;
      else if (f->fn_argn & X_JL)
	{
	  jumpto = expr[0] + ((unsigned) (expr[1]) << 8);
	  expr += 2;
	}

      switch (f->fn_argn & X_ARGS)
	{
	  /* A0 is special, since it makes the stack grow, while
			   all the others make the stack the same size or
			   less. . . */
	case X_A0:
	  numarg = 0;
	  if (curstack == stackmax)
	    {
	      stackmax *= 2;
	      stack = (struct value *) ck_realloc (stack, sizeof (struct value) * stackmax);
	    }
	  p = &stack[curstack];
	  curstack++;
	  break;

	case X_A1:
	  numarg = 1;
	  break;

	case X_A2:
	  numarg = 2;
	  break;
	case X_A3:
	  numarg = 3;
	  break;
	case X_A4:
	  numarg = 4;
	  break;
	case X_AN:
	  numarg = *expr++;
	  break;
	default:
	  numarg = 0;
	  p = 0;
#ifdef TEST
	  panic ("Unknown arg_num %d", f->fn_argn);
#endif
	}
      if (numarg > 0)
	{
	  int xt;

#ifdef TEST
	  if (curstack < numarg)
	    panic ("Only %u values on stack, not %u", curstack, numarg);
#endif
	  p = &stack[curstack - numarg];
	  curstack -= (numarg - 1);
	  for (xt = 0; xt < numarg; xt++)
	    {
	      switch (f->fn_argt[xt <= 3 ? xt : 3])
		{
		  /* A is for anything */
		  /* Any non-range value */
		case 'A':
		  TO_ANY (p + xt);
		  break;
		  /* B is for boolean */
		case 'B':
		  TO_BOL (p + xt);
		  break;
		  /* D is for Don't check */
		case 'D':
		  break;
		  /* E is for Everything */
		case 'E':
		  break;
		  /* F is for Float */
		case 'F':
		  TO_FLT (p + xt);
		  break;
		  /* I is for Int */
		case 'I':
		  TO_INT (p + xt);
		  break;
		  /* N is for Number (int or float) */
		case 'N':
		  TO_NUM (p + xt);
		  break;
		  /* R is for Range */
		case 'R':
		  TO_RNG (p + xt);
		  break;
		  /* S is for String */
		case 'S':
		  TO_STR (p + xt);
		  break;
#ifdef TEST
		default:
		  io_error_msg ("YIKE!  Unknown argtype for Fun %u  arg #%u", byte, xt);
		  break;
#endif
		}
	    }
	}

      switch (byte)
	{
	case IF_L:
	case F_IF_L:
	case IF:
	case F_IF:
	  if (p->type != TYP_BOL)
	    {
	      if (p->type != TYP_ERR)
		{
		  p->type = TYP_ERR;
		  p->Value = NON_BOOL;
		}
	      expr += jumpto;
	      if (expr[-2] != SKIP)
		jumpto = expr[-1] + (((unsigned) expr[-2]) << 8);
	      else
		jumpto = expr[-1];
	      expr += jumpto;	/* Skip both branches of the if */

	    }
	  else if (p->Value == 0)
	    {
	      expr += jumpto;
	      --curstack;
	    }
	  else
	    --curstack;
	  break;

	case SKIP_L:
	case SKIP:
	  --curstack;
	  expr += jumpto;
	  break;

	case AND_L:
	case AND:
	  if (p->type == TYP_ERR)
	    expr += jumpto;
	  else if (p->type != TYP_BOL)
	    {
	      p->type = TYP_ERR;
	      p->Value = NON_BOOL;
	      expr += jumpto;
	    }
	  else if (p->Value == 0)
	    expr += jumpto;
	  else
	    --curstack;
	  break;

	case OR_L:
	case OR:
	  if (p->type == TYP_ERR)
	    expr += jumpto;
	  else if (p->type != TYP_BOL)
	    {
	      p->type = TYP_ERR;
	      p->Value = NON_BOOL;
	      expr += jumpto;
	    }
	  else if (p->Value)
	    expr += jumpto;
	  else
	    --curstack;
	  break;

	case CONST_FLT:
	  p->type = TYP_FLT;
	  bcopy ((VOIDSTAR) expr, (VOIDSTAR) (&(p->Float)), sizeof (double));
	  expr += sizeof (double);
	  break;

	case CONST_INT:
	  p->type = TYP_INT;
	  bcopy ((VOIDSTAR) expr, (VOIDSTAR) (&(p->Int)), sizeof (long));
	  expr += sizeof (long);
	  break;

	case CONST_STR:
	case CONST_STR_L:
	  p->type = TYP_STR;
	  p->String = (char *) expr + jumpto;
	  break;

	case CONST_ERR:
	  p->type = TYP_ERR;
	  p->Value = *expr++;
	  /* expr+=sizeof(char *); */
	  break;

	case CONST_INF:
	case CONST_NINF:
	case CONST_NAN:
	  p->type = TYP_FLT;
	  p->Float = (byte == CONST_INF) ? __plinf : ((byte == CONST_NINF) ? __neinf : __nan);
	  break;

	case VAR:
	  {
	    struct var *varp;

	    bcopy ((VOIDSTAR) expr, (VOIDSTAR) (&varp), sizeof (struct var *));
	    expr += sizeof (struct var *);
	    switch (varp->var_flags)
	      {
	      case VAR_UNDEF:
		p->type = TYP_ERR;
		p->Value = BAD_NAME;
		break;

	      case VAR_CELL:
		cell_ptr = find_cell (varp->v_rng.lr, varp->v_rng.lc);
		PUSH_ANY (cell_ptr);
		break;

	      case VAR_RANGE:
		if (varp->v_rng.lr == varp->v_rng.hr && varp->v_rng.lc == varp->v_rng.hc)
		  {
		    cell_ptr = find_cell (varp->v_rng.lr, varp->v_rng.lc);
		    PUSH_ANY (cell_ptr);
		  }
		else
		  {
		    p->type = TYP_RNG;
		    p->Rng = varp->v_rng;
		  }
		break;
#ifdef TEST
	      default:
		panic ("Unknown var type %d", varp->var_flags);
#endif
	      }
	  }
	  break;

	  /* Cell refs */
	case R_CELL:
	case R_CELL | COLREL:
	case R_CELL | ROWREL:
	case R_CELL | ROWREL | COLREL:
	  {
	    CELLREF torow, tocol;

	    torow = GET_ROW (expr);
	    tocol = GET_COL (expr);
	    expr += EXP_ADD;
	    cell_ptr = find_cell ((CELLREF) torow, (CELLREF) tocol);
	    PUSH_ANY (cell_ptr);
	  }
	  break;

	case RANGE:
	case RANGE | LRREL:
	case RANGE | LRREL | LCREL:
	case RANGE | LRREL | LCREL | HCREL:
	case RANGE | LRREL | HCREL:
	case RANGE | LRREL | HRREL:
	case RANGE | LRREL | HRREL | LCREL:
	case RANGE | LRREL | HRREL | LCREL | HCREL:
	case RANGE | LRREL | HRREL | HCREL:
	case RANGE | HRREL:
	case RANGE | HRREL | LCREL:
	case RANGE | HRREL | LCREL | HCREL:
	case RANGE | HRREL | HCREL:
	case RANGE | LCREL:
	case RANGE | LCREL | HCREL:
	case RANGE | HCREL:
	  p->type = TYP_RNG;
	  GET_RNG (expr, &(p->Rng));
	  expr += EXP_ADD_RNG;
	  break;

	case F_TRUE:
	case F_FALSE:
	  p->type = TYP_BOL;
	  p->Value = (byte == F_TRUE);
	  break;

	case F_PI:
	  p->type = TYP_FLT;
	  p->Float = PI;
	  break;

	case F_ROW:
	case F_COL:
	  p->type = TYP_INT;
	  p->Int = ((byte == F_ROW) ? cur_row : cur_col);
	  break;

	case F_NOW:
	  p->type = TYP_INT;
	  p->Int = time ((VOIDSTAR) 0);
	  break;

	  /* Single operand instrs */
	case F_ABS:
	case F_ACOS:
	case F_ASIN:
	case F_ATAN:
	case F_CEIL:
	case F_COS:
	case F_DTR:
	case F_EXP:
	case F_FLOOR:
	case F_INT:
	case F_LOG:
	case F_LOG10:
	case F_RTD:
	case F_SIN:
	case F_SQRT:
	case F_TAN:
	  {
#ifdef __STDC__
	    double (*funp1) (double);
	    funp1 = (double (*)(double)) (f->fn_fun);
#else
	    double (*funp1) ();
	    funp1 = (double (*)()) (f->fn_fun);
#endif

	    p->Float = (*funp1) (p->Float);
	    if (p->Float != p->Float)
	      ERROR (OUT_OF_RANGE);
	  }
	  break;

	case F_CTIME:
	  p->type = TYP_STR;
	  strptr = ctime ((time_t*) &p->Int);
	  p->String = obstack_alloc (&tmp_mem, 25);
	  strncpy (p->String, strptr, 24);
	  p->String[24] = '\0';
	  break;

	case NEGATE:
	case F_NEG:
	  if (p->type == TYP_ERR)
	    break;
	  if (p->type == TYP_INT)
	    p->Int = -(p->Int);
	  else if (p->type == TYP_FLT)
	    p->Float = -(p->Float);
	  else
	    ERROR (NON_NUMBER);
	  break;

	case F_RND:
	  p->Int = (random () % (p->Int)) + 1;
	  break;

	case NOT:
	case F_NOT:
	  p->Value = !(p->Value);
	  break;

	case F_ISERR:
	  p->Value = (p->type == TYP_ERR);
	  p->type = TYP_BOL;
	  break;

	case F_ISNUM:
	  if (p->type == TYP_FLT || p->type == TYP_INT)
	    p->Value = 1;
	  else if (p->type == TYP_STR)
	    {
	      strptr = p->String;
	      (void) astof (&strptr);
	      p->Value = (*strptr == '\0');
	    }
	  else
	    p->Value = 0;
	  p->type = TYP_BOL;
	  break;

	case F_ROWS:
	case F_COLS:
	  p->type = TYP_INT;
	  p->Int = 1 + (byte == F_ROWS ? (p->Rng.hr - p->Rng.lr) : (p->Rng.hc - p->Rng.lc));
	  break;

	  /* Two operand cmds */
	case F_ATAN2:
	case F_HYPOT:
	case POW:
	  {
#ifdef __STDC__
	    double (*funp2) (double, double);
	    funp2 = (double (*)(double, double)) (f->fn_fun);
#else
	    double (*funp2) ();
	    funp2 = (double (*)()) (f->fn_fun);
#endif

	    p->Float = (*funp2) (p->Float, (p + 1)->Float);
	    if (p->Float != p->Float)
	      ERROR (OUT_OF_RANGE);
	  }
	  break;

	case DIFF:
	case DIV:
	case MOD:
	case PROD:
	case SUM:

	  if (p->type != (p + 1)->type)
	    {
	      if (p->type == TYP_INT)
		{
		  p->type = TYP_FLT;
		  p->Float = (double) p->Int;
		}
	      if ((p + 1)->type == TYP_INT)
		{
		  (p + 1)->type = TYP_FLT;
		  (p + 1)->Float = (double) ((p + 1)->Int);
		}
	    }
	  if (p->type == TYP_INT)
	    {
	      switch (byte)
		{
		case DIFF:
		  I_SUB (p->Int, (p + 1)->Int);
		  break;
		case DIV:
		  if ((p + 1)->Int == 0)
		    ERROR (DIV_ZERO);
		  I_DIV (p->Int, (p + 1)->Int);
		  break;
		case MOD:
		  if ((p + 1)->Int == 0)
		    ERROR (DIV_ZERO);
		  I_MOD (p->Int, (p + 1)->Int);
		  break;
		case PROD:
		  I_MUL (p->Int, (p + 1)->Int);
		  break;
		case SUM:
		  I_ADD (p->Int, (p + 1)->Int);
		  break;
#ifdef TEST
		default:
		  panic ("Evaluator confused by byte-value %d", byte);
#endif
		}
	    }
	  else
	    {
	      switch (byte)
		{
		case DIFF:
		  F_SUB (p->Float, (p + 1)->Float);
		  break;
		case DIV:
		  if ((p + 1)->Float == 0)
		    ERROR (DIV_ZERO);
		  F_DIV (p->Float, (p + 1)->Float);
		  break;
		case MOD:
		  if ((p + 1)->Float == 0)
		    ERROR (DIV_ZERO);
		  F_MOD (p->Float, (p + 1)->Float);
		  break;
		case PROD:
		  F_MUL (p->Float, (p + 1)->Float);
		  break;
		case SUM:
		  F_ADD (p->Float, (p + 1)->Float);
		  break;
#ifdef TEST
		default:
		  panic ("Unknown operation %d", byte);
#endif
		}
	    }
	  if (overflow)
	    ERROR (OUT_OF_RANGE);
	  break;

	case EQUAL:
	case NOTEQUAL:

	case GREATEQ:
	case GREATER:
	case LESS:
	case LESSEQ:
	  if (p->type == TYP_ERR)
	    break;
	  if ((p + 1)->type == TYP_ERR)
	    ERROR ((p + 1)->Value);

	  if (p->type == TYP_BOL || (p + 1)->type == TYP_BOL)
	    {
	      if (p->type != (p + 1)->type || (byte != EQUAL && byte != NOTEQUAL))
		ERROR (BAD_INPUT);
	      if (byte == EQUAL)
		p->Value = p->Value == (p + 1)->Value;
	      else
		p->Value = p->Value != (p + 1)->Value;
	      break;
	    }
	  if (p->type != (p + 1)->type)
	    {
	      if (p->type == 0)
		{
		  if ((p + 1)->type == TYP_STR)
		    {
		      p->type = TYP_STR;
		      p->String = "";
		    }
		  else if ((p + 1)->type == TYP_INT)
		    {
		      p->type = TYP_INT;
		      p->Int = 0;
		    }
		  else
		    {
		      p->type = TYP_FLT;
		      p->Float = 0.0;
		    }
		}
	      else if ((p + 1)->type == 0)
		{
		  if (p->type == TYP_STR)
		    {
		      (p + 1)->type = TYP_STR;
		      (p + 1)->String = "";
		    }
		  else if (p->type == TYP_INT)
		    {
		      (p + 1)->type = TYP_INT;
		      (p + 1)->Int = 0;
		    }
		  else
		    {
		      (p + 1)->type = TYP_FLT;
		      (p + 1)->Float = 0.0;
		    }
		}
	      else if (p->type == TYP_STR)
		{
		  strptr = p->String;
		  if ((p + 1)->type == TYP_INT)
		    {
		      p->type = TYP_INT;
		      p->Int = astol (&strptr);
		    }
		  else
		    {
		      p->type = TYP_FLT;
		      p->Float = astof (&strptr);
		    }
		  if (*strptr)
		    {
		      p->type = TYP_BOL;
		      p->Value = (byte == NOTEQUAL);
		      break;
		    }
		}
	      else if ((p + 1)->type == TYP_STR)
		{
		  strptr = (p + 1)->String;
		  if (p->type == TYP_INT)
		    (p + 1)->Int = astol (&strptr);
		  else
		    (p + 1)->Float = astof (&strptr);
		  if (*strptr)
		    {
		      p->type = TYP_BOL;
		      p->Value = (byte == NOTEQUAL);
		      break;
		    }

		  /* If we get here, one is INT, and the other
				   is FLT  Make them both FLT */
		}
	      else if (p->type == TYP_INT)
		{
		  p->type = TYP_FLT;
		  p->Float = (double) p->Int;
		}
	      else
		(p + 1)->Float = (double) (p + 1)->Int;
	    }
	  if (p->type == TYP_STR)
	    tmp = strcmp (p->String, (p + 1)->String);
	  else if (p->type == TYP_FLT)
	    tmp = (p->Float < (p + 1)->Float) ? -1 : ((p->Float > (p + 1)->Float) ? 1 : 0);
	  else if (p->type == TYP_INT)
	    tmp = (p->Int < (p + 1)->Int ? -1 : ((p->Int > (p + 1)->Int) ? 1 : 0));
	  else if (p->type == 0)
	    tmp = 0;
	  else
	    {
	      tmp = 0;
	      panic ("Bad type value %d", p->type);
	    }
	  p->type = TYP_BOL;
	  if (tmp < 0)
	    p->Value = (byte == NOTEQUAL || byte == LESS || byte == LESSEQ);
	  else if (tmp == 0)
	    p->Value = (byte == EQUAL || byte == GREATEQ || byte == LESSEQ);
	  else
	    p->Value = (byte == NOTEQUAL || byte == GREATER || byte == GREATEQ);
	  break;

	case F_FIXED:
	  tmp = (p + 1)->Int;
	  if (tmp < -29 || tmp > 29)
	    ERROR (OUT_OF_RANGE);
	  if (tmp < 0)
	    p->Float = rint ((p->Float) / exp10_arr[-tmp]) * exp10_arr[-tmp];
	  else
	    p->Float = rint ((p->Float) * exp10_arr[tmp]) / exp10_arr[tmp];
	  break;

	case F_IFERR:
	  if (p->type == TYP_ERR)
	    *p = *(p + 1);
	  break;

	case F_INDEX:
	  tmp = (p + 1)->Int - 1;
	  if (tmp < 0)
	    ERROR (OUT_OF_RANGE);
	  lrow = p->Rng.lr;
	  lcol = p->Rng.lc;
	  hrow = p->Rng.hr;
	  hcol = p->Rng.hc;
	  if (lrow != hrow && lcol != hcol)
	    {
	      int dex;

	      dex = 1 + hrow - lrow;
	      if (tmp >= dex * (1 + hcol - lcol))
		ERROR (OUT_OF_RANGE);
	      crow = tmp % dex;
	      ccol = tmp / dex;
	      lrow += crow;
	      lcol += ccol;
	    }
	  else if (lrow != hrow)
	    {
	      if (tmp > (hrow - lrow))
		ERROR (OUT_OF_RANGE);
	      lrow += tmp;
	    }
	  else
	    {
	      if (tmp > (hcol - lcol))
		ERROR (OUT_OF_RANGE);
	      lcol += tmp;
	    }
	  cell_ptr = find_cell (lrow, lcol);
	  PUSH_ANY (cell_ptr);
	  break;

	case F_INDEX2:
	  crow = (p + 1)->Int - 1;
	  ccol = (p + 2)->Int - 1;
	  lrow = p->Rng.lr;
	  lcol = p->Rng.lc;
	  hrow = p->Rng.hr;
	  hcol = p->Rng.hc;
	  if (crow > (hrow - lrow) || ccol > (hcol - lcol)) 
	    ERROR (OUT_OF_RANGE);
	  cell_ptr = find_cell (lrow + crow, lcol + ccol);
	  PUSH_ANY (cell_ptr);
	  break;

	  /* case F_PRINTF:
			panic("no printf yet");
			break; */

	case CONCAT:
	  strptr = (char *) obstack_alloc (&tmp_mem, strlen (p->String) + strlen ((p + 1)->String) + 1);
	  strcpy (strptr, p->String);
	  strcat (strptr, (p + 1)->String);
	  p->String = strptr;
	  break;

	case F_ONEOF:
	  if (numarg < 2)
	    ERROR (NO_VALUES);
	  --numarg;
	  tmp = p->Int;
	  if (tmp < 1 || tmp > numarg)
	    ERROR (OUT_OF_RANGE);
	  /* Can never happen? */
	  TO_ANY (p + tmp);
	  p[0] = p[tmp];
	  break;

	case F_FILE:
	  {
	    FILE *fp;
	    char buf[128];
	    int num;

	    if (numarg < 1)
	      ERROR (NO_VALUES);
	    fp = fopen (p->String, "r");
	    if (!fp)
	      ERROR (BAD_INPUT);
	    switch (numarg)
	      {
	      case 2:
		fseek (fp, (p + 1)->Int, 0);
		/* Fallthrough */

	      case 1:
		while ((num = fread (buf, sizeof (char), sizeof (buf), fp)) > 0)
		    (void) obstack_grow (&tmp_mem, buf, num);
		break;

	      case 3:
		fseek (fp, (p + 1)->Int, 0);
		for (;;)
		  {
		    num = ((p + 2)->Int < sizeof (buf)) ? (p + 2)->Int : sizeof (buf);
		    (p + 2)->Int -= num;
		    num = fread (buf, sizeof (char), num, fp);
		    (void) obstack_grow (&tmp_mem, buf, num);
		    if (num == 0 || (p + 2)->Int == 0)
		      break;
		  }
		break;

	      default:
		ERROR (BAD_INPUT);
	      }
	    fclose (fp);
	    (void) obstack_1grow (&tmp_mem, 0);
	    p->String = obstack_finish (&tmp_mem);
	    break;
	  }

	case AREA_SUM:
	case AREA_PROD:
	case AREA_AVG:
	case AREA_STD:
	case AREA_MAX:
	case AREA_MIN:
	case AREA_CNT:
	case AREA_VAR:
	  tmp = deal_area (byte, numarg, p);
	  if (tmp)
	    ERROR (tmp);
	  break;

	  /* This is now a fallthrough for all the USRmumble codes */
	case USR1:
	default:
	  if ((f->fn_argn & X_ARGS) == X_AN)
	    {
#ifdef __STDC__
	      void (*funp) (int, struct value *);
	      funp = (void (*)(int, struct value *)) f->fn_fun;
#else
	      void (*funp) ();
	      funp = (void (*)()) f->fn_fun;
#endif
	      (*funp) (numarg, p);
	    }
	  else
	    {
#ifdef __STDC__
	      void (*funp) (struct value *);
	      funp = (void (*)(struct value *)) f->fn_fun;
#else
	      void (*funp) ();
	      funp = (void (*)()) f->fn_fun;
#endif
	      (*funp) (p);
	    }
	  break;

	  /* #ifdef TEST
		default:
			panic("Unknown byte-value %d",byte);
			break;
#endif */
	}
      /* Goto next-byte is the equiv of a multi-level break, which
		   C doesn't allow. */
    next_byte:
      ;
    }
#ifdef TEST
  if (curstack != 1)
    io_error_msg ("%d values on stack", curstack);
#endif
  return stack;
}

/* These helper functions were split out so that eval_expression would compile
   under Turbo C 2.0 on my PC.
 */


static int cnt_flt;
static int cnt_int;

static long int_tmp;
static double flt_tmp;

static long sqr_int_tmp;	/* for AREA_STD */
static double sqr_flt_tmp;

static unsigned char area_cmd;

static int
deal_area (cmd, num_args, p)
     unsigned char cmd;
     unsigned char num_args;
     struct value *p;
{
  double flt_cnt_flt;
  CELL *cell_ptr;
  char *strptr;

  area_cmd = cmd;
  cnt_flt = 0;
  cnt_int = 0;
  for (; num_args--;)
    {
      switch (p[num_args].type)
	{
	case TYP_INT:
	  add_int (p[num_args].Int);
	  break;

	case TYP_FLT:
	  add_flt (p[num_args].Float);
	  break;

	case TYP_STR:
	  strptr = p[num_args].String;
	  flt_cnt_flt = astof (&strptr);
	  if (*strptr)
	    return NON_NUMBER;
	  add_flt (flt_cnt_flt);
	  break;

	case TYP_RNG:
	  find_cells_in_range (&(p[num_args].Rng));
	  while (cell_ptr = next_cell_in_range ())
	    {
	      if (GET_TYP (cell_ptr) == TYP_FLT)
		add_flt (cell_ptr->cell_flt);
	      else if (GET_TYP (cell_ptr) == TYP_INT)
		add_int (cell_ptr->cell_int);
	      else if (GET_TYP (cell_ptr) == TYP_STR)
		{
		  strptr = cell_ptr->cell_str;
		  flt_cnt_flt = astof (&strptr);
		  if (!*strptr)
		    add_flt (flt_cnt_flt);
		}
	    }
	  break;

	case 0:
	  break;

	case TYP_ERR:
	  return p[num_args].Value;

	default:
	  return NON_NUMBER;
	}
    }
  if (!cnt_flt && !cnt_int && area_cmd != AREA_CNT)
    return NO_VALUES;

  switch (area_cmd)
    {
    case AREA_SUM:
      if (cnt_flt && cnt_int)
	{
	  flt_tmp += (double) int_tmp;
	  cnt_int = 0;
	}
      break;
    case AREA_PROD:
      if (cnt_flt && cnt_int)
	{
	  flt_tmp *= (double) int_tmp;
	  cnt_int = 0;
	}
      break;
    case AREA_AVG:
      if (cnt_flt && cnt_int)
	{
	  flt_tmp += (double) int_tmp;
	  flt_tmp /= (double) ((cnt_flt + cnt_int));
	  cnt_int = 0;
	}
      else if (cnt_flt)
	flt_tmp /= (double) cnt_flt;
      else
	{
	  flt_tmp = (double) int_tmp / (double) cnt_int;
	  cnt_int = 0;
	}
      break;
    case AREA_STD:
      if (cnt_int && cnt_flt)
	{
	  flt_tmp += (double) int_tmp;
	  sqr_flt_tmp += (double) sqr_int_tmp;
	  cnt_flt += cnt_int;
	  cnt_int = 0;
	}
      else if (cnt_int)
	{
	  flt_tmp = (double) int_tmp;
	  sqr_flt_tmp = (double) sqr_int_tmp;
	  cnt_flt = cnt_int;
	  cnt_int = 0;
	}
      flt_cnt_flt = (double) cnt_flt;
      flt_tmp = sqrt (((flt_cnt_flt * sqr_flt_tmp) -
		       (flt_tmp * flt_tmp)) /
		      (flt_cnt_flt * (flt_cnt_flt - 1)));
      break;
    case AREA_VAR:
      if (cnt_int && cnt_flt)
	{
	  flt_tmp += (double) int_tmp;
	  sqr_flt_tmp += (double) sqr_int_tmp;
	  cnt_flt += cnt_int;
	  cnt_int = 0;
	}
      else if (cnt_int)
	{
	  flt_tmp = (double) int_tmp;
	  sqr_flt_tmp = (double) sqr_int_tmp;
	  cnt_flt = cnt_int;
	  cnt_int = 0;
	}
      flt_cnt_flt = (double) cnt_flt;
      flt_tmp = ((flt_cnt_flt * sqr_flt_tmp) -
		 (flt_tmp * flt_tmp)) /
	(flt_cnt_flt * flt_cnt_flt);
      break;

    case AREA_MAX:
      if (cnt_flt && cnt_int && flt_tmp > (double) int_tmp)
	cnt_int = 0;
      break;

    case AREA_MIN:
      if (cnt_flt && cnt_int && flt_tmp < (double) int_tmp)
	cnt_int = 0;
      break;

    case AREA_CNT:
      int_tmp = cnt_int + cnt_flt;
      cnt_int = 1;
      break;

#ifdef TEST
    default:
      panic ("Unknown AREA command %d", area_cmd);
#endif
    }
  if (cnt_int)
    {
      p->type = TYP_INT;
      p->Int = int_tmp;
    }
  else
    {
      p->type = TYP_FLT;
      p->Float = flt_tmp;
    }
  return 0;
}

static void
add_flt (value)
     double value;
{
  if (cnt_flt++ == 0)
    {
      flt_tmp = value;
      sqr_flt_tmp = value * value;
      return;
    }

  switch (area_cmd)
    {
    case AREA_STD:
    case AREA_VAR:
      sqr_flt_tmp += value * value;
      /* Fall through */
    case AREA_SUM:
    case AREA_AVG:
      flt_tmp += value;
      return;
    case AREA_PROD:
      flt_tmp *= value;
      return;
    case AREA_MAX:
      if (flt_tmp < value)
	flt_tmp = value;
      return;
    case AREA_MIN:
      if (flt_tmp > value)
	flt_tmp = value;
      return;
    case AREA_CNT:
      return;
#ifdef TEST
    default:
      panic ("Unknown area command %d in add_flt(%g)", area_cmd, value);
#endif
    }
}

static void
add_int (value)
     long value;
{
  if (cnt_int++ == 0)
    {
      int_tmp = value;
      sqr_int_tmp = value * value;
      return;
    }

  switch (area_cmd)
    {
    case AREA_STD:
    case AREA_VAR:
      sqr_int_tmp += value * value;
      /* Fall through */
    case AREA_SUM:
    case AREA_AVG:
      int_tmp += value;
      return;
    case AREA_PROD:
      int_tmp *= value;
      return;
    case AREA_MAX:
      if (int_tmp < value)
	int_tmp = value;
      return;
    case AREA_MIN:
      if (int_tmp > value)
	int_tmp = value;
      return;
    case AREA_CNT:
      return;
#ifdef TEST
    default:
      panic ("Unknown Area command %d in add_int(%ld)", area_cmd, value);
#endif
    }
}

#ifdef __STDC__
double
dtr (double x)
#else
double
dtr (x)
     double x;
#endif
{
  return x * (PI / (double) 180.0);
}

#ifdef __STDC__
double
rtd (double x)
#else
double
rtd (x)
     double x;
#endif
{
  return x * (180.0 / (double) PI);
}

#ifdef __STDC__
double
to_int (double x)
#else
double
to_int (x)
     double x;
#endif
{
  return (x < 0 ? ceil (x) : floor (x));
}

/* Various methods of dealing with arithmatic overflow.  They don't work well.
   Someone should really convince this thing to properly deal with it.
 */
#ifdef __TURBOC__
int
matherr (exc)
     struct exception *exc;
{
  stack[curstack].type = TYP_ERR;
  stack[curstack].Value = BAD_INPUT;
  write (2, "MATHERR\n", 8);
  return 1;
}

#endif

#ifndef __TURBOC__
RETSIGTYPE
math_sig (sig)
     int sig;
{
  stack[curstack].type = TYP_ERR;
  stack[curstack].Value = BAD_INPUT;
}

#endif

/* Here's the entry point for this module. */
void
update_cell (cell)
     CELL *cell;
{
  struct value *new;
  int new_val;

  new = eval_expression (cell->cell_formula);
  if (!new)
    {
      push_refs (cell->cell_refs_from);
      return;
    }
  cell->cell_cycle = current_cycle;

  if (new->type != GET_TYP (cell))
    {
      if (GET_TYP (cell) == TYP_STR)
	free (cell->cell_str);
      SET_TYP (cell, new->type);
      new_val = 1;
      if (new->type == TYP_STR)
	new->String = strdup (new->String);
    }
  else
    switch (new->type)
      {
      case 0:
	new_val = 0;
	break;
      case TYP_FLT:
	new_val = new->Float != cell->cell_flt;
	break;
      case TYP_INT:
	new_val = new->Int != cell->cell_int;
	break;
      case TYP_STR:
	new_val = strcmp (new->String, cell->cell_str);
	if (new_val)
	  {
	    free (cell->cell_str);
	    new->String = strdup (new->String);
	  }
	break;
      case TYP_BOL:
	new_val = new->Value != cell->cell_bol;
	break;
      case TYP_ERR:
	new_val = new->Value != cell->cell_err;
	break;
      default:
	new_val = 0;
#ifdef TEST
	panic ("Unknown type %d in update_cell", new->type);
#endif
      }
  if (new_val)
    {
      cell->c_z = new->x;
      push_refs (cell->cell_refs_from);
    }
  (void) obstack_free (&tmp_mem, tmp_mem_start);
}

int
fls (num)
     long num;
{
  int ret = 1;

  if (!num)
    return 0;
  if (num < 0)
    num = -num;
  if (num & 0xffff0000)
    {
      ret += 16;
      num = (num >> 16) & 0xffff;
    }
  if (num & 0xff00)
    {
      ret += 8;
      num >>= 8;
    }
  if (num & 0xf0)
    {
      ret += 4;
      num >>= 4;
    }
  if (num & 0x0c)
    {
      ret += 2;
      num >>= 2;
    }
  if (num & 2)
    ret++;
  return ret;
}

#ifdef SMALLEVAL
int
__to_flt (p)
     struct value *p;
{
  char *strptr;

  switch (p->type)
    {
    case 0:
      p->type = TYP_FLT;
      p->Float = 0;
      /* Fallthrough */
    case TYP_FLT:
      return 0;
    case TYP_INT:
      p->Float = (double) p->Int;
      p->type = TYP_FLT;
      return 0;
    case TYP_STR:
      p->type = TYP_FLT;
      strptr = p->String;
      p->Float = astof (&strptr);
      if (*strptr)
	return NON_NUMBER;
      return 0;
    case TYP_ERR:
      return p->Value;
    default:
      return NON_NUMBER;
    }
}

int
__to_int (p)
     struct value *p;
{
  char *strptr;

  switch (p->type)
    {
    case 0:
      p->type = TYP_INT;
      p->Int = 0;
    case TYP_INT:
      return 0;
    case TYP_FLT:
      p->type = TYP_INT;
      p->Int = (long) p->Float;
      return 0;
    case TYP_STR:
      p->type = TYP_INT;
      strptr = p->String;
      p->Int = astol (&strptr);
      if (*strptr)
	return NON_NUMBER;
      return 0;
    case TYP_ERR:
      return p->Value;
    default:
      return NON_NUMBER;
    }
}

int
__to_num (p)
     struct value *p;
{
  char *strptr;

  switch (p->type)
    {
    case 0:
      p->type = TYP_INT;
      p->Int = 0;
      return 0;
    case TYP_FLT:
    case TYP_INT:
      return 0;
    case TYP_STR:
      p->type = TYP_FLT;
      strptr = p->String;
      p->Float = astof (&strptr);
      if (*strptr)
	return NON_NUMBER;
      return 0;
    case TYP_ERR:
      return p->Value;
    default:
      return NON_NUMBER;
    }
}

int
__to_str (p)
     struct value *p;
{
  char *strptr;

  switch (p->type)
    {
    case 0:
      p->type = TYP_STR;
      p->String = obstack_alloc (&tmp_mem, 1);
      p->String[0] = '\0';
      return 0;

    case TYP_STR:
      return 0;

    case TYP_INT:
      p->type = TYP_STR;
      strptr = obstack_alloc (&tmp_mem, 30);
      sprintf (strptr, "%ld", p->Int);
      p->String = strptr;
      return 0;

    case TYP_FLT:
      p->type = TYP_STR;
      strptr = flt_to_str (p->Float);
      (void) obstack_grow (&tmp_mem, strptr, strlen (strptr) + 1);
      p->String = obstack_finish (&tmp_mem);
      return 0;

    case TYP_ERR:
      return p->Value;

    default:
      return NON_STRING;
    }
}

int
__to_bol (p)
     struct value *p;
{
  switch (p->type)
    {
    case TYP_BOL:
      return 0;
    case TYP_ERR:
      return p->Value;
    default:
      return NON_BOOL;
    }
}

int
__to_rng (p)
     struct value *p;
{
  switch (p->type)
    {
    case TYP_RNG:
      return 0;
    case TYP_ERR:
      return p->Value;
    default:
      return NON_BOOL;
    }
}

#endif
