#include <math.h>
#include <float.h>

#include "atof.h"
#include "defs.h"
#include "prims.h"
#include "random.h"

static const double fltmax = FLT_MAX *  .999;
static const double fltmin = FLT_MIN * 1.001;

#define LIMITFLOAT(var) \
 do { if ((var > fltmax) || (var < -fltmax)) ABORT_INTERP		\
 ("Floating overflow."); else if ((var < fltmin) && (var > -fltmin))	\
 var = 0; else if (var != var) ABORT_INTERP("NaN result"); } while (0)

PRIM(add)
{
 struct inst *v1;
 struct inst *v2;
 int irv;
 double frv;
 dbref drv;
 MUFQUAD qrv;

 NARGS(2);
 v2 = TOS(0);
 v1 = TOS(1);
 switch (v1->type)
  { case PROG_INTEGER:
       switch (v2->type)
	{ case PROG_INTEGER:
	     irv = v1->data.number + v2->data.number; goto ret_integer; break;
	  case PROG_FLOAT:
	     frv = v1->data.number + *v2->data.flt; goto ret_float; break;
	  case PROG_VAR:
	     irv = v1->data.number + v2->data.number; goto ret_var; break;
	  case PROG_OBJECT:
	     drv = v1->data.number + v2->data.objref; goto ret_dbref; break;
	  case PROG_QUAD:
	     qrv = v1->data.number + *v2->data.quad; goto ret_quad; break;
	}
       break;
    case PROG_FLOAT:
       switch (v2->type)
	{ case PROG_INTEGER:
	     frv = *v1->data.flt + v2->data.number; goto ret_float; break;
	  case PROG_FLOAT:
	     frv = *v1->data.flt + *v2->data.flt; goto ret_float; break;
	  case PROG_QUAD:
	     frv = *v1->data.flt + *v2->data.quad; goto ret_float; break;
	}
       break;
    case PROG_VAR:
       switch (v2->type)
	{ case PROG_INTEGER:
	     irv = v1->data.number + v2->data.number; goto ret_var; break;
	}
       break;
    case PROG_OBJECT:
       switch (v2->type)
	{ case PROG_INTEGER:
	     drv = v1->data.objref + v2->data.number; goto ret_dbref; break;
	}
       break;
    case PROG_QUAD:
       switch (v2->type)
	{ case PROG_INTEGER:
	     qrv = *v1->data.quad + v2->data.number; goto ret_quad; break;
	  case PROG_FLOAT:
	     frv = *v1->data.quad + *v2->data.flt; goto ret_float; break;
	  case PROG_QUAD:
	     qrv = *v1->data.quad + *v2->data.quad; goto ret_quad; break;
	}
       break;
  }
 ABORT_INTERP("Invalid argument types.");
ret_integer:; POP(2); MPUSH(PROG_INTEGER,irv); return;
ret_float:; POP(2); LIMITFLOAT(frv); MPUSH(PROG_FLOAT,frv); return;
ret_quad:; POP(2); MPUSH(PROG_QUAD,qrv); return;
ret_var:; POP(2); MPUSH(PROG_VAR,irv); return;
ret_dbref:; POP(2); MPUSH(PROG_OBJECT,drv); return;
}

PRIM(subtract)
{
 struct inst *v1;
 struct inst *v2;
 int irv;
 double frv;
 dbref drv;
 MUFQUAD qrv;

 NARGS(2);
 v2 = TOS(0);
 v1 = TOS(1);
 switch (v1->type)
  { case PROG_INTEGER:
       switch (v2->type)
	{ case PROG_INTEGER:
	     irv = v1->data.number - v2->data.number; goto ret_integer; break;
	  case PROG_FLOAT:
	     frv = v1->data.number - *v2->data.flt; goto ret_float; break;
	  case PROG_QUAD:
	     qrv = v1->data.number - *v2->data.quad; goto ret_quad; break;
	}
       break;
    case PROG_FLOAT:
       switch (v2->type)
	{ case PROG_INTEGER:
	     frv = *v1->data.flt - v2->data.number; goto ret_float; break;
	  case PROG_FLOAT:
	     frv = *v1->data.flt - *v2->data.flt; goto ret_float; break;
	  case PROG_QUAD:
	     frv = *v1->data.flt - *v2->data.quad; goto ret_float; break;
	}
       break;
    case PROG_VAR:
       switch (v2->type)
	{ case PROG_INTEGER:
	     irv = v1->data.number - v2->data.number; goto ret_var; break;
	  case PROG_VAR:
	     irv = v1->data.number - v2->data.number; goto ret_integer; break;
	}
       break;
    case PROG_OBJECT:
       switch (v2->type)
	{ case PROG_INTEGER:
	     drv = v1->data.objref - v2->data.number; goto ret_dbref; break;
	  case PROG_OBJECT:
	     irv = v1->data.objref - v2->data.objref; goto ret_integer; break;
	}
       break;
    case PROG_QUAD:
       switch (v2->type)
	{ case PROG_INTEGER:
	     qrv = *v1->data.quad - v2->data.number; goto ret_quad; break;
	  case PROG_FLOAT:
	     frv = *v1->data.quad - *v2->data.flt; goto ret_float; break;
	  case PROG_QUAD:
	     qrv = *v1->data.quad - *v2->data.quad; goto ret_quad; break;
	}
       break;
  }
 ABORT_INTERP("Invalid argument types.");
ret_integer:; POP(2); MPUSH(PROG_INTEGER,irv); return;
ret_float:; POP(2); LIMITFLOAT(frv); MPUSH(PROG_FLOAT,frv); return;
ret_quad:; POP(2); MPUSH(PROG_QUAD,qrv); return;
ret_var:; POP(2); MPUSH(PROG_VAR,irv); return;
ret_dbref:; POP(2); MPUSH(PROG_OBJECT,drv); return;
}

#define FOO(name,expr) \
PRIM(name)								\
{									\
 struct inst *v;							\
									\
 NARGS(1);								\
 v = TOS(0);								\
 switch (v->type)							\
  { case PROG_INTEGER:							\
	{ int rv;							\
	  rv = v->data.number;						\
	  POP(1);							\
	  MPUSH(PROG_INTEGER,(expr));					\
	}								\
       break;								\
    case PROG_FLOAT:							\
	{ double rv;							\
	  rv = *v->data.flt;						\
	  POP(1);							\
	  MPUSH(PROG_FLOAT,(expr));					\
	}								\
       break;								\
    default:								\
       ABORT_INTERP("Invalid argument type.");				\
       break;								\
  }									\
}

FOO(neg,-rv)
FOO(abs,(rv<0)?-rv:rv)

#undef FOO

PRIM(multiply)
{
 struct inst *v1;
 struct inst *v2;
 int irv;
 double frv;
 MUFQUAD qrv;

 NARGS(2);
 v2 = TOS(0);
 v1 = TOS(1);
 switch (v1->type)
  { case PROG_INTEGER:
       switch (v2->type)
	{ case PROG_INTEGER:
	     irv = v1->data.number * v2->data.number; goto ret_integer; break;
	  case PROG_FLOAT:
	     frv = v1->data.number * *v2->data.flt; goto ret_float; break;
	  case PROG_QUAD:
	     qrv = v1->data.number * *v2->data.quad; goto ret_quad; break;
	}
       break;
    case PROG_FLOAT:
       switch (v2->type)
	{ case PROG_INTEGER:
	     frv = *v1->data.flt * v2->data.number; goto ret_float; break;
	  case PROG_FLOAT:
	     frv = *v1->data.flt * *v2->data.flt; goto ret_float; break;
	  case PROG_QUAD:
	     frv = *v1->data.flt * *v2->data.quad; goto ret_float; break;
	}
       break;
    case PROG_QUAD:
       switch (v2->type)
	{ case PROG_INTEGER:
	     qrv = *v1->data.quad * v2->data.number; goto ret_quad; break;
	  case PROG_FLOAT:
	     frv = *v1->data.quad * *v2->data.flt; goto ret_float; break;
	  case PROG_QUAD:
	     qrv = *v1->data.quad * *v2->data.quad; goto ret_quad; break;
	}
       break;
  }
 ABORT_INTERP("Invalid argument types.");
ret_integer:; POP(2); MPUSH(PROG_INTEGER,irv); return;
ret_float:; POP(2); LIMITFLOAT(frv); MPUSH(PROG_FLOAT,frv); return;
ret_quad:; POP(2); MPUSH(PROG_QUAD,qrv); return;
}

PRIM(divide)
{
 struct inst *v1;
 struct inst *v2;
 int irv;
 double frv;
 MUFQUAD qrv;

 NARGS(2);
 v2 = TOS(0);
 v1 = TOS(1);
 switch (v2->type)
  { case PROG_INTEGER:
       if (v2->data.number == 0) goto div0;
       switch (v1->type)
	{ case PROG_INTEGER:
	     irv = v1->data.number / v2->data.number; goto ret_integer; break;
	  case PROG_FLOAT:
	     frv = *v1->data.flt / v2->data.number; goto ret_float; break;
	  case PROG_QUAD:
	     qrv = *v1->data.quad / v2->data.number; goto ret_quad; break;
	}
       break;
    case PROG_FLOAT:
       if (*v2->data.flt == 0) goto div0;
       switch (v1->type)
	{ case PROG_INTEGER:
	     frv = v1->data.number / *v2->data.flt; goto ret_float; break;
	  case PROG_FLOAT:
	     frv = *v1->data.flt / *v2->data.flt; goto ret_float; break;
	  case PROG_QUAD:
	     frv = *v1->data.quad / *v2->data.flt; goto ret_float; break;
	}
       break;
    case PROG_QUAD:
       if (*v2->data.quad == 0) goto div0;
       switch (v1->type)
	{ case PROG_INTEGER:
	     qrv = v1->data.number / *v2->data.quad; goto ret_quad; break;
	  case PROG_FLOAT:
	     frv = *v1->data.flt / *v2->data.quad; goto ret_float; break;
	  case PROG_QUAD:
	     qrv = *v1->data.quad / *v2->data.quad; goto ret_quad; break;
	}
       break;
  }
 ABORT_INTERP("Invalid argument types.");
div0:;
 ABORT_INTERP("Division by zero.");
ret_integer:; POP(2); MPUSH(PROG_INTEGER,irv); return;
ret_float:; POP(2); LIMITFLOAT(frv); MPUSH(PROG_FLOAT,frv); return;
ret_quad:; POP(2); MPUSH(PROG_QUAD,qrv); return;
}

PRIM(divide0)
{
 struct inst *v1;
 struct inst *v2;

 NARGS(2);
 v2 = TOS(0);
 v1 = TOS(1);
 if ((v1->type == PROG_INTEGER) && (v2->type == PROG_INTEGER))
  { int rv;
    rv = v2->data.number ? (v1->data.number / v2->data.number) : 0;
    POP(2);
    MPUSH(PROG_INTEGER,rv);
  }
 else
  { ABORT_INTERP("Invalid argument types.");
  }
}

PRIM(mod)
{
 struct inst *v1;
 struct inst *v2;
 int irv;
 double frv;
 MUFQUAD qrv;

 NARGS(2);
 v2 = TOS(0);
 v1 = TOS(1);
 switch (v2->type)
  { case PROG_INTEGER:
       if (v2->data.number == 0) goto mod0;
       switch (v1->type)
	{ case PROG_INTEGER:
	     irv = v1->data.number % v2->data.number; goto ret_integer; break;
	  case PROG_FLOAT:
	     frv = fmod(*v1->data.flt,v2->data.number); goto ret_float; break;
	  case PROG_QUAD:
	     irv = *v1->data.quad % v2->data.number; goto ret_integer; break;
	}
       break;
    case PROG_FLOAT:
       if (*v2->data.flt == 0) goto mod0;
       switch (v1->type)
	{ case PROG_INTEGER:
	     frv = fmod(v1->data.number,*v2->data.flt); goto ret_float; break;
	  case PROG_FLOAT:
	     frv = fmod(*v1->data.flt,*v2->data.flt); goto ret_float; break;
	  case PROG_QUAD:
	     frv = fmod(*v1->data.quad,*v2->data.flt); goto ret_float; break;
	}
       break;
    case PROG_QUAD:
       if (*v2->data.quad == 0) goto mod0;
       switch (v1->type)
	{ case PROG_INTEGER:
	     qrv = v1->data.number % *v2->data.quad; goto ret_quad; break;
	  case PROG_FLOAT:
	     frv = fmod(*v1->data.flt,*v2->data.quad); goto ret_float; break;
	  case PROG_QUAD:
	     qrv = *v1->data.quad % *v2->data.quad; goto ret_quad; break;
	}
       break;
  }
 ABORT_INTERP("Invalid argument types.");
mod0:;
 ABORT_INTERP("Remainder by zero.");
ret_integer:; POP(2); MPUSH(PROG_INTEGER,irv); return;
ret_float:; POP(2); LIMITFLOAT(frv); MPUSH(PROG_FLOAT,frv); return;
ret_quad:; POP(2); MPUSH(PROG_QUAD,qrv); return;
}

PRIM(mod0)
{
 struct inst *v1;
 struct inst *v2;

 NARGS(2);
 v2 = TOS(0);
 v1 = TOS(1);
 if ((v1->type == PROG_INTEGER) && (v2->type == PROG_INTEGER))
  { int rv;
    rv = v2->data.number ? (v1->data.number % v2->data.number) : 0;
    POP(2);
    MPUSH(PROG_INTEGER,rv);
  }
 else
  { ABORT_INTERP("Invalid argument types.");
  }
}

PRIM(divmod)
{
 struct inst *v1;
 struct inst *v2;
 int quo;
 int irem;
 double frem;
 MUFQUAD qrem;

 NARGS(2);
 v2 = TOS(0);
 v1 = TOS(1);
 switch (v2->type)
  { case PROG_INTEGER:
       if (v2->data.number == 0) goto divmod0;
       switch (v1->type)
	{ case PROG_INTEGER:
	     quo = v1->data.number / v2->data.number;
	     irem = v1->data.number - (quo * v2->data.number);
	     goto ret_integer;
	     break;
	  case PROG_FLOAT:
	     quo = *v1->data.flt / v2->data.number;
	     frem = *v1->data.flt - (quo * v2->data.number);
	     goto ret_float;
	     break;
	  case PROG_QUAD:
	     quo = *v1->data.quad / v2->data.number;
	     qrem = *v1->data.quad - (quo * v2->data.number);
	     goto ret_quad;
	     break;
	}
       break;
    case PROG_FLOAT:
       if (*v2->data.flt == 0) goto divmod0;
       switch (v1->type)
	{ case PROG_INTEGER:
	     quo = v1->data.number / *v2->data.flt;
	     frem = v1->data.number - (quo * *v2->data.flt);
	     goto ret_float;
	     break;
	  case PROG_FLOAT:
	     quo = *v1->data.flt / *v2->data.flt;
	     frem = *v1->data.flt - (quo * *v2->data.flt);
	     goto ret_float;
	     break;
	  case PROG_QUAD:
	     quo = *v1->data.quad / *v2->data.flt;
	     frem = *v1->data.quad - (quo * *v2->data.flt);
	     goto ret_float;
	     break;
	}
       break;
    case PROG_QUAD:
       if (*v2->data.quad == 0) goto divmod0;
       switch (v1->type)
	{ case PROG_INTEGER:
	     quo = v1->data.number / *v2->data.quad;
	     qrem = v1->data.number - (quo * *v2->data.quad);
	     goto ret_quad;
	     break;
	  case PROG_FLOAT:
	     quo = *v1->data.flt / *v2->data.quad;
	     frem = *v1->data.flt - (quo * *v2->data.quad);
	     goto ret_float;
	     break;
	  case PROG_QUAD:
	     quo = *v1->data.quad / *v2->data.quad;
	     qrem = *v1->data.quad - (quo * *v2->data.quad);
	     goto ret_quad;
	     break;
	}
       break;
  }
 ABORT_INTERP("Invalid argument types.");
divmod0:;
 ABORT_INTERP("/% by zero.");
ret_integer:; POP(2); MPUSH(PROG_INTEGER,quo); MPUSH(PROG_INTEGER,irem); return;
ret_float:; POP(2); MPUSH(PROG_INTEGER,quo); LIMITFLOAT(frem); MPUSH(PROG_FLOAT,frem); return;
ret_quad:; POP(2); MPUSH(PROG_INTEGER,quo); MPUSH(PROG_QUAD,qrem); return;
}

#define FOO(name,cmp) \
PRIM(name)								\
{									\
 struct inst *v1;							\
 struct inst *v2;							\
 int rv;								\
									\
 NARGS(2);								\
 v2 = TOS(0);								\
 v1 = TOS(1);								\
 switch (v1->type)							\
  { case PROG_INTEGER:							\
    case PROG_VAR:							\
       switch (v2->type)						\
	{ case PROG_INTEGER:						\
	  case PROG_VAR:						\
	     rv = v1->data.number cmp v2->data.number; break;		\
	  case PROG_OBJECT:						\
	     rv = v1->data.number cmp v2->data.objref; break;		\
	  case PROG_FLOAT:						\
	     rv = v1->data.number cmp *v2->data.flt; break;		\
	  case PROG_QUAD:						\
	     rv = v1->data.number cmp *v2->data.quad;			\
	  default: goto badargs; break;					\
	}								\
       break;								\
    case PROG_OBJECT:							\
       switch (v2->type)						\
	{ case PROG_INTEGER:						\
	  case PROG_VAR:						\
	     rv = v1->data.objref cmp v2->data.number; break;		\
	  case PROG_OBJECT:						\
	     rv = v1->data.objref cmp v2->data.objref; break;		\
	  case PROG_FLOAT:						\
	     rv = v1->data.objref cmp *v2->data.flt; break;		\
	  case PROG_QUAD:						\
	     rv = v1->data.objref cmp *v2->data.quad;			\
	  default: goto badargs; break;					\
	}								\
       break;								\
    case PROG_FLOAT:							\
       switch (v2->type)						\
	{ case PROG_INTEGER:						\
	  case PROG_VAR:						\
	     rv = *v1->data.flt cmp v2->data.number; break;		\
	  case PROG_OBJECT:						\
	     rv = *v1->data.flt cmp v2->data.objref; break;		\
	  case PROG_FLOAT:						\
	     rv = *v1->data.flt cmp *v2->data.flt; break;		\
	  case PROG_QUAD:						\
	     rv = *v1->data.flt cmp *v2->data.quad;			\
	  default: goto badargs; break;					\
	}								\
       break;								\
    case PROG_QUAD:							\
       switch (v2->type)						\
	{ case PROG_INTEGER:						\
	  case PROG_VAR:						\
	     rv = *v1->data.quad cmp v2->data.number; break;		\
	  case PROG_OBJECT:						\
	     rv = *v1->data.quad cmp v2->data.objref; break;		\
	  case PROG_FLOAT:						\
	     rv = *v1->data.quad cmp *v2->data.flt; break;		\
	  case PROG_QUAD:						\
	     rv = *v1->data.quad cmp *v2->data.quad;			\
	  default: goto badargs; break;					\
	}								\
       break;								\
    default: goto badargs; break;					\
  }									\
 POP(2);								\
 MPUSH(PROG_INTEGER,rv);						\
 return;								\
badargs:;								\
 ABORT_INTERP("Invalid argument types.");				\
}

FOO(cmp_lt,<)
FOO(cmp_gt,>)
FOO(cmp_eq,==)
FOO(cmp_ne,!=)
FOO(cmp_le,<=)
FOO(cmp_ge,>=)

#undef FOO

#define FOO(name,op) \
PRIM(name)								\
{									\
 struct inst *v1;							\
 struct inst *v2;							\
									\
 NARGS(2);								\
 v2 = TOS(0);								\
 v1 = TOS(1);								\
 if ((v1->type == PROG_INTEGER) && (v2->type == PROG_INTEGER))		\
  { int rv;								\
    rv = v1->data.number op v2->data.number;				\
    POP(2);								\
    MPUSH(PROG_INTEGER,rv);						\
  }									\
 else if ((v1->type == PROG_INTEGER) && (v2->type == PROG_QUAD))	\
  { MUFQUAD rv;								\
    rv = v1->data.number op *v2->data.quad;				\
    POP(2);								\
    MPUSH(PROG_QUAD,rv);						\
  }									\
 else if ((v1->type == PROG_QUAD) && (v2->type == PROG_INTEGER))	\
  { MUFQUAD rv;								\
    rv = *v1->data.quad op v2->data.number;				\
    POP(2);								\
    MPUSH(PROG_QUAD,rv);						\
  }									\
 else if ((v1->type == PROG_QUAD) && (v2->type == PROG_QUAD))		\
  { MUFQUAD rv;								\
    rv = *v1->data.quad op *v2->data.quad;				\
    POP(2);								\
    MPUSH(PROG_QUAD,rv);						\
  }									\
 else									\
  { ABORT_INTERP("Invalid argument types.");				\
  }									\
}

FOO(bitor,|)
FOO(bitand,&)
FOO(bitxor,^)

#undef FOO

PRIM(bitnot)
{
 struct inst *v;

 NARGS(1);
 v = TOS(0);
 switch (v->type)
  { case PROG_INTEGER:
	{ int rv;
	  rv = ~v->data.number;
	  POP(1);
	  MPUSH(PROG_INTEGER,rv);
	}
       break;
    case PROG_QUAD:
	{ MUFQUAD rv;
	  rv = ~*v->data.quad;
	  POP(1);
	  MPUSH(PROG_QUAD,rv);
	}
       break;
    default:
       ABORT_INTERP("Invalid argument type.");
       break;
  }
}

PRIM(random)
{
 STACKROOM(1);
 MPUSH(PROG_INTEGER,rndint());
}

PRIM(frandom)
{
 STACKROOM(1);
 MPUSH(PROG_FLOAT,frnd());
}

PRIM(qrandom)
{
 STACKROOM(1);
 MPUSH(PROG_QUAD,rndquad());
}

PRIM(dbcomp)
{
 struct inst *v1;
 struct inst *v2;
 int rv;

 NARGS(2);
 v2 = TOS(0);
 v1 = TOS(1);
 if ((v1->type != PROG_OBJECT) || (v2->type != PROG_OBJECT))
  { ABORT_INTERP("Invalid argument type.");
  }
 rv = v1->data.objref == v2->data.objref;
 POP(2);
 MPUSH(PROG_INTEGER,rv);
}

PRIM(at)
{
 struct inst *v;
 int n;

 NARGS(1);
 v = TOS(0);
 if (v->type != PROG_VAR)
  { ABORT_INTERP("Non-variable argument.");
  }
 n = v->data.number;
 if ((n < 0) || (n >= MAX_VAR))
  { ABORT_INTERP("Invalid variable argument.");
  }
 POP(1);
 copyinst(&fr->variables[n],&arg[(*top)++]);
}

PRIM(bang)
{
 struct inst *vvar;
 struct inst *vval;
 int n;

 NARGS(2);
 vvar = TOS(0);
 vval = TOS(1);
 if (vvar->type != PROG_VAR)
  { ABORT_INTERP("Non-variable argument (2)");
  }
 n = vvar->data.number;
 if ((n < 0) || (n >= MAX_VAR))
  { ABORT_INTERP("Invalid variable argument (2)");
  }
 CLEAR(&fr->variables[n]);
 copyinst(vval,&fr->variables[n]);
 POP(2);
}

#define FOO(name,op) \
PRIM(name) { struct inst *v; struct inst *var; int n;			\
	NARGS(1); v = TOS(0); if (v->type != PROG_VAR)			\
	{ ABORT_INTERP("Non-variable argument."); }			\
	n = v->data.number; if ((n < 0) || (n >= MAX_VAR))		\
	{ ABORT_INTERP("Invalid variable argument."); }			\
	var = &fr->variables[n]; switch (var->type)			\
	{ case PROG_INTEGER: case PROG_VAR: var->data.number op; break;	\
	  case PROG_OBJECT: var->data.objref op; break;			\
	  case PROG_QUAD: (*var->data.quad) op; break;			\
	  default: ABORT_INTERP("Variable value has invalid type.");	\
	  break; } POP(1); }

FOO(pplus,++)
FOO(mminus,--)

#undef FOO

#define FOO(name,op1,op2) \
PRIM(name)								\
{									\
 struct inst *v1;							\
 struct inst *v2;							\
									\
 NARGS(2);								\
 v2 = TOS(0);								\
 v1 = TOS(1);								\
 if (v2->type != PROG_INTEGER)						\
  {									\
badargtype:;								\
    ABORT_INTERP("Invalid argument type.");				\
  }									\
 switch (v1->type)							\
  { case PROG_INTEGER:							\
	{ int rv;							\
	  rv = (v2->data.number < 0)					\
	       ? (v1->data.number op2 -v2->data.number)			\
	       : (v1->data.number op1 v2->data.number);			\
	  POP(2);							\
	  MPUSH(PROG_INTEGER,rv);					\
	}								\
       break;								\
    case PROG_QUAD:							\
	{ MUFQUAD rv;							\
	  rv = (v2->data.number < 0)					\
	       ? (*v1->data.quad op2 -v2->data.number)			\
	       : (*v1->data.quad op1 v2->data.number);			\
	  POP(2);							\
	  MPUSH(PROG_QUAD,rv);						\
	}								\
       break;								\
    default: goto badargtype; break;					\
  }									\
}

FOO(bitrotleft,<<,>>)
FOO(bitrotright,>>,<<)

#undef FOO

PRIM(atof)
{
 struct inst *v;
 double d;

 NARGS(1);
 v = TOS(0);
 if ((v->type != PROG_STRING) || !v->data.string)
  { d = 0;
  }
 else
  { d = atof(v->data.string);
    LIMITFLOAT(d);
  }
 POP(1);
 MPUSH(PROG_FLOAT,d);
}

PRIM(float)
{
 struct inst *v;
 double d;

 NARGS(1);
 v = TOS(0);
 switch (v->type)
  { case PROG_INTEGER:
       d = v->data.number;
       break;
    case PROG_QUAD:
       d = *v->data.quad;
       break;
    default:
       ABORT_INTERP("Invalid argument type.");
       break;
  }
 POP(1);
 MPUSH(PROG_FLOAT,d);
}

#define FOO(name,expr) \
PRIM(name) { struct inst *v; double d; NARGS(1); v = TOS(0);		\
 if (v->type != PROG_FLOAT) ABORT_INTERP("Non-float argument.");	\
 d = *v->data.flt; POP(1); MPUSH(PROG_INTEGER,(int)(expr)); }

FOO(floor,floor(d))
FOO(ceil,ceil(d))
FOO(round,(d<0)?(d-.5):(d+.5))
FOO(trunc,d)

#undef FOO

#define FOO(name) \
PRIM(name)								\
{									\
 struct inst *v;							\
 double d;								\
									\
 NARGS(1);								\
 v = TOS(0);								\
 switch (v->type)							\
  { case PROG_INTEGER: d = v->data.number; break;			\
    case PROG_QUAD: d = *v->data.quad; break;				\
    case PROG_FLOAT: d = *v->data.flt; break;				\
    default: ABORT_INTERP("Non-number argument."); break;		\
  }									\
 d = name(d);								\
 LIMITFLOAT(d);								\
 POP(1);								\
 MPUSH(PROG_FLOAT,d);							\
}

FOO(sin)
FOO(cos)
FOO(tan)
FOO(asin)
FOO(acos)
FOO(atan)
FOO(sinh)
FOO(cosh)
FOO(tanh)
FOO(asinh)
FOO(acosh)
FOO(atanh)
FOO(exp)
FOO(expm1)
FOO(log)
FOO(log1p)
FOO(log10)
FOO(sqrt)
FOO(cbrt)

#undef FOO

#define FOO(name) \
PRIM(name)								\
{									\
 struct inst *v;							\
 double d1;								\
 double d2;								\
 double d;								\
									\
 NARGS(2);								\
 v = TOS(0);								\
 switch (v->type)							\
  { case PROG_INTEGER: d2 = v->data.number; break;			\
    case PROG_FLOAT: d2 = *v->data.flt; break;				\
    case PROG_QUAD: d2 = *v->data.quad; break;				\
    default: ABORT_INTERP("Non-number argument (2)."); break;		\
  }									\
 v = TOS(1);								\
 switch (v->type)							\
  { case PROG_INTEGER: d1 = v->data.number; break;			\
    case PROG_FLOAT: d1 = *v->data.flt; break;				\
    case PROG_QUAD: d1 = *v->data.quad; break;				\
    default: ABORT_INTERP("Non-number argument (1)."); break;		\
  }									\
 d = name(d1,d2);							\
 LIMITFLOAT(d);								\
 POP(2);								\
 MPUSH(PROG_FLOAT,d);							\
}

FOO(atan2)
FOO(pow)
FOO(hypot)

#undef FOO

PRIM(sincos)
{
 struct inst *v;
 double d;
 double s;
 double c;

 NARGS(1);
 v = TOS(0);
 switch (v->type)
  { case PROG_INTEGER: d = v->data.number; break;
    case PROG_FLOAT: d = *v->data.flt; break;
    case PROG_QUAD: d = *v->data.quad; break;
    default: ABORT_INTERP("Non-number argument."); break;
  }
#ifdef NO_SINCOS
 s = sin(d);
 c = cos(d);
#else
 sincos(d,&s,&c);
#endif
 LIMITFLOAT(s);
 LIMITFLOAT(c);
 STACKROOM(1);
 POP(1);
 MPUSH(PROG_FLOAT,s);
 MPUSH(PROG_FLOAT,c);
}

PRIM(ldexp)
{
 struct inst *v;
 double d;
 double i;

 NARGS(2);
 v = TOS(0);
 if (v->type != PROG_INTEGER) ABORT_INTERP("Non-integer argument (2).");
 i = v->data.number;
 v = TOS(1);
 if (v->type != PROG_FLOAT) ABORT_INTERP("Non-float argument (2).");
 d = *v->data.flt;
 d = ldexp(d,i);
 LIMITFLOAT(d);
 POP(2);
 MPUSH(PROG_FLOAT,d);
}

PRIM(frexp)
{
 struct inst *v;
 double d;
 int i;

 NARGS(1);
 v = TOS(0);
 if (v->type != PROG_FLOAT) ABORT_INTERP("Non-float argument.");
 d = *v->data.flt;
 d = frexp(d,&i);
 STACKROOM(1);
 POP(1);
 MPUSH(PROG_FLOAT,d);
 MPUSH(PROG_INTEGER,i);
}

PRIM(pi)
{
 STACKROOM(1);
 MPUSH(PROG_FLOAT,3.1415926535897932384626433);
}

PRIM(e)
{
 STACKROOM(1);
 MPUSH(PROG_FLOAT,2.7182818284590452353602874);
}