/* eval.c -- STAR Functions and Operators

This file is part of STAR, the Saturn Macro Assembler.

   STAR is not distributed by the Free Software Foundation. Do not ask
them for a copy or how to obtain new releases. Instead, send e-mail to
the address below. STAR is merely covered by the GNU General Public
License.

Please send your comments, ideas, and bug reports to
Jan Brittenson <bson@ai.mit.edu>

*/


/* Copyright (C) 1990, 1991 Jan Brittenson.

   STAR 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 1, or (at your option) any
later version.

   STAR 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 STAR; see the file COPYING. If not, to obtain a copy, write
to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139,
USA, or send e-mail to bson@ai.mit.edu. */

/*
 * All the 'evxx' routines are called with a standard interface:
 *
 *	OPX:	struct val opx(cpp, term)	opx = op term;
 *			char **cpp;
 *			struct val term;
 *
 *	XOPY:	struct val xopy(cpp, term1, term2)
 *			char **cpp;
 *			struct val term1, term2;  xopy = term1 op term2;
 */

#include <stdio.h>
#include <math.h>
#include "star.h"
#include "literals.h"
#include "symbols.h"


/* External functions/data */
extern SYM_ROOT
  *symtbl;
extern
  errcnt, pass;
extern char
  *str();


/* Global variables/data */
int noseq;


/* Make sure valid digit */
is_digit(c)
  char c;
{
  if(!isdigit(c))
    {
      sgnerr("Invalid number");
      return(FALSE);
    }
  return(TRUE);
}


/* Compute current instance level of
 * existing symbol.
 */
instances_sym(symp)
  struct sstruct *symp;
{
  int n;
  register struct vnode *vp;

  if(!symp)
    return(0);

  for(n = 1, vp = symp->vlink; vp; n++, vp = vp->vlink);
  
  return(n);
}


/* Compute current instance level of
 * symbol, return 0 if symbol does not exist.
 */
instances(name)
  char *name;
{
  return(instances_sym(sm_find_sym(symtbl, name)));
}
  

/* XOPY:  Not equal */
struct val evbne(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  if(term1.type != term2.type)
    return(val_one);

  switch(term1.type)
    {
    case VT_INT: return(intval(term1.vint != term2.vint));
    case VT_REAL: return(intval(term1.vdouble != term2.vdouble));
    case VT_STR: return(intval(!scmp(term1.vstr, term2.vstr)));
    case VT_SECT:
    case VT_OP:
    case VT_MAC: return(val_zero);
    default:
      fatal("`Not equal' operator applied to bogus type %d", term1.type);
    }
}

/* OPX:  Boolean not */
struct val evbnot(cpp, term)
  char **cpp;
  struct val term;
{
  return(intval(!toint(term).vint));
}


/* OPX:  Logical complement */
struct val evlnot(cpp, term)
  char **cpp;
  struct val term;
{
  return(intval(~toint(term).vint));
}


/* OPX:  Right mask */
struct val evrmask(cpp, term)
  char **cpp;
  struct val term;
{
  return(intval((1 << toint(term).vint) - 1));
}


/* XOPY: Left shift */
struct val evlshf(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  term1 = toint(term1);
  term2 = toint(term2);

  term1.vint <<= term2.vint;
  
  return(term1);
}


/* XOPY: Right shift */
struct val evrshf(cpp, term1, term2)
  char **cpp;
  struct val term1,term2;
{
  term1 = toint(term1);
  term2 = toint(term2);

  term1.vint >>= term2.vint;

  return(term1);
}


/* XOPY: Less than or equal */
struct val evble(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  if(term1.type != term2.type)
    return(val_zero);

  switch(term1.type)
    {
    case VT_INT: return(intval(term1.vint <= term2.vint));
    case VT_REAL: return(intval(term1.vdouble <= term2.vdouble));
    case VT_STR: return(intval(scmp(term1.vstr, term2.vstr) <= 0));
    case VT_SECT:
    case VT_OP:
    case VT_MAC: return(val_zero);
    default:
      fatal("`Less than' operator applied to bogus type %d", term1.type);
    }
}


/* XOPY: Greater than or equal */
struct val evbge(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  if(term1.type != term2.type)
    return(val_zero);

  switch(term1.type)
    {
    case VT_INT: return(intval(term1.vint >= term2.vint));
    case VT_REAL: return(intval(term1.vdouble >= term2.vdouble));
    case VT_STR: return(intval(scmp(term1.vstr, term2.vstr) >= 0));
    case VT_OP:
    case VT_SECT:
    case VT_MAC: return(val_zero);
    default:
      fatal("`Greater than' operator applied to bogus type %d", term1.type);
    }
}


/* XOPY: Less than */
struct val evblt(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  if(term1.type != term2.type)
    return(val_zero);

  switch(term1.type)
    {
    case VT_INT: return(intval(term1.vint < term2.vint));
    case VT_REAL: return(intval(term1.vdouble < term2.vdouble));
    case VT_STR: return(intval(scmp(term1.vstr, term2.vstr) < 0));
    case VT_SECT:
    case VT_OP:
    case VT_MAC: return(val_zero);
    default:
      fatal("`Less than' operator applied to bogus type %d", term1.type);
    }
}


/* XOPY: Greater than */
struct val evbgt(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  if(term1.type != term2.type)
    return(val_zero);

  switch(term1.type)
    {
    case VT_INT: return(intval(term1.vint > term2.vint));
    case VT_REAL: return(intval(term1.vdouble > term2.vdouble));
    case VT_STR: return(intval(scmp(term1.vstr, term2.vstr) > 0));
    case VT_SECT:
    case VT_OP:
    case VT_MAC: return(val_zero);
    default:
      fatal("`Greater than' operator applied to bogus type %d", term1.type);
    }
}


/* XOPY: Equal */
struct val evbeq(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  if(term1.type != term2.type)
    return(val_zero);

  switch(term1.type)
    {
    case VT_INT: return(intval(term1.vint == term2.vint));
    case VT_REAL: return(intval(term1.vdouble == term2.vdouble));
    case VT_STR: return(intval(!scmp(term1.vstr, term2.vstr)));
    case VT_SECT:
    case VT_OP:
    case VT_MAC: return(val_zero);
    default:
      fatal("`Equal to' operator applied to bogus type %d", term1.type);
    }
}


/* XOPY: Boolean or */
struct val evbor(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  term1 = toint(term1);
  term2 = toint(term2);

  if(term1.vint || term2.vint)
    return(val_one);

  return(val_zero);
}


/* XOPY: Boolean and */
struct val evband(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  term1 = toint(term1);
  term2 = toint(term2);

  if(term1.vint && term2.vint)
    return(val_one);

  return(val_zero);
}


/* XOPY: Bitwise or */
struct val evlor(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  term1 = toint(term1);
  term2 = toint(term2);

  return(intval(term1.vint | term2.vint));
}


/* XOPY: Bitwise and */
struct val evland(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  term1 = toint(term1);
  term2 = toint(term2);

  return(intval(term1.vint & term2.vint));
}


/* XOPY: Boolean xor */
struct val evbxor(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  term1 = toint(term1);
  term2 = toint(term2);

  if((!term1.vint && term2.vint) ||
     (term1.vint && !term2.vint))
    return(val_one);

  return(val_zero);
}


/* XOPY: Bitwise xor */
struct val evlxor(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  term1 = toint(term1);
  term2 = toint(term2);

  return(intval(term1.vint ^ term2.vint));
}


/* XOPY: Add */
struct val evadd(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  extern char *expr_allp, *expr_strdup();

  /* If either is double, make both double and return double result */
  if(term1.type == VT_REAL || term2.type == VT_REAL)
    {
      term1 = toreal(term1);
      term2 = toreal(term2);

      return(realval(term1.vdouble + term2.vdouble));
    }

  if(term1.type == VT_STR && term2.type == VT_STR)
    {
      /* Reallocate strings, and discard intermediate NUL */
      term1.vstr = expr_strdup(term1.vstr);
      expr_allp--;
      expr_strdup(term2.vstr);
      return(term1);
    }

  term1 = toint(term1);
  term2 = toint(term2);

  return(intval(term1.vint + term2.vint));
}


/* XOPY: Subtract */
struct val evsub(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  /* If either is double, make both double and return double result */
  if(term1.type == VT_REAL || term2.type == VT_REAL)
    {
      term1 = toreal(term1);
      term2 = toreal(term2);
      
      return(realval(term1.vdouble - term2.vdouble));
    }

  term1 = toint(term1);
  term2 = toint(term2);

  return(intval(term1.vint - term2.vint));
}


/* OPX: Unary minus */
struct val evneg(cpp, term)
  char **cpp;
  struct val term;
{
  /* If term is double, make it double and return double result */
  if(term.type == VT_REAL)
    {
      term = toreal(term);

      return(realval(-term.vdouble));
    }

  return(intval(-toint(term).vint));
}


/* XOPY: Division */
struct val evdiv(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  /* If either is double, make the other double and return double result */
  if(term1.type == VT_REAL || term2.type == VT_REAL)
    {
      term1 = toreal(term1);
      term2 = toreal(term2);

      return(realval(term1.vdouble / term2.vdouble));
    }

  term1 = toint(term1);
  term2 = toint(term2);

  return(intval(term1.vint / term2.vint));
}


/* XOPY: Multiplication */
struct val evmul(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  /* If either is double, make both double and return double result */
  if(term1.type == VT_REAL || term2.type == VT_REAL)
    {
      term1 = toreal(term1);
      term2 = toreal(term2);

      return(realval(term1.vdouble * term2.vdouble));
    }

  term1 = toint(term1);
  term2 = toint(term2);

  return(intval(term1.vint * term2.vint));
}


/* XOPY: Modulo */
struct val  evmod(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  /* If either is double, make both double and return double result */
  if(term1.type == VT_REAL || term2.type == VT_REAL)
    {
      term1 = toreal(term1);
      term2 = toreal(term2);

      return(realval(fmod(term1.vdouble, term2.vdouble)));
    }

  term1 = toint(term1);
  term2 = toint(term2);

  return(intval(term1.vint % term2.vint));
}


/* OPX: Bit field */
struct val evbits(cpp)
  char **cpp;
{
  int tmp, tmpx;
  
  tmp = 0;
  noseq = TRUE;
  
  for(;;)
    {
      /* Evaluate expression */
      tmpx = toint(evexpr(cpp)).vint;
      tmp |= (1 << tmpx);
      
      /* Is there another entry in line? */
      *cpp = byspace(*cpp);
      
      if(**cpp != ',')
	if(**cpp != ']')
	  {
	    sgnerr("Bad bit field element");
	    return(val_zero);
	  }
	else	/* End of field */
	  {
	    (*cpp)++;
	    return(intval(tmp));
	  }
      
      /* Further arguments */
      *cpp = byspace(++(*cpp));
    }
}


/* OPX: Octal number conversion */
struct val evoct(cpp)
  char **cpp;
{
  INT tmp;
  char *save = *cpp;
  extern struct fstruct *fhit;
  
  noseq = TRUE;
  tmp = (INT) 0;
  
  if(!isoct(**cpp))
    {
      /* Prefix "0" is a special case, which is correct */
      if(!fhit->auxval)
	sgnerr("Invalid octal constant");

      return(val_zero);
    }
  
  /* Loop until no more digits */
  while(isoct(**cpp))
    {
      tmp *= 8L;
      tmp += **cpp - 48L;
      (*cpp)++;
    }
  
  /* Dot or 'e' - then redo as real */
  if(toupper(**cpp) == 'E' || **cpp == '.')
    {
      *cpp = save;
      return(evreal(cpp));
    }

  return(intval(tmp));
}


/* OPX: Binary number conversion */
struct val evbin(cpp)
  char **cpp;
{
  INT tmp;
  char *save = *cpp;
  
  noseq = TRUE;
  tmp = 0L;
  
  is_digit(**cpp);
  
  /* Loop until no more digits */
  while(**cpp == '0' || **cpp == '1')
    {
      tmp += tmp;
      tmp += **cpp - 48L;
      (*cpp)++;
    }
  
  /* Dot or 'e' - then redo as real */
  if(toupper(**cpp) == 'E' || **cpp == '.')
    {
      *cpp = save;
      return(evreal(cpp));
    }

  return(intval(tmp));
}


/* OPX: Real number parsing */
struct val evreal(cpp)
  char **cpp;
{
  extern double strtod();

  return(realval((REAL) strtod(*cpp, cpp)));
}


/* OPX: return local symbol value */
struct val evlocal(cpp)
  char **cpp;
{
  extern struct val local_value();

  return(local_value((unsigned long) evdec(cpp).vint));
}


/* OPX: Decimal number conversion */
struct val evdec(cpp)
  char **cpp;
{
  INT tmp;
  char *save = *cpp;
  
  noseq = TRUE;
  tmp = (INT) 0;
  
  is_digit(**cpp);
  
  /* Loop until no more digits */
  while(isdigit(**cpp))
    {
      tmp *= 10L;
      tmp += **cpp - 48L;
      (*cpp)++;
    }
  
  /* Dot or 'e' - then redo as real */
  if(toupper(**cpp) == 'E' || **cpp == '.')
    {
      *cpp = save;
      return(evreal(cpp));
    }
  
  return(intval(tmp));
}


/* OPX: Hexadecimal number conversion */
struct val evhex(cpp)
  char **cpp;
{
  INT tmp;
  char *save = *cpp;
  
  tmp = (INT) 0;
  noseq = TRUE;

  if(!ishex(**cpp))
    {
      sgnerr("Invalid hex constant");
      return(val_zero);
    }
  
  /* Loop until no more digits */
  while(ishex(**cpp))
    {
      tmp *= 16L;
      tmp += ((**cpp >= '0' && **cpp <= '9') ?
	      (**cpp - 48L)		:
	      ((**cpp & ~32L) - 55L));
      (*cpp)++;
    }

  
  return(intval(tmp));
}


/* OPX: Opening parenthesis */
struct val evleft(cpp)
  char **cpp;
{
  struct val tmp;

  /* Evaluate expression */
  *cpp = byspace(*cpp);
  tmp = evexpr(cpp);
  
  mustbe(cpp, ')');
  
  return(tmp);
}


/* Scan symbol in stream */
char *scansym(cpp, tmpcp)
  char **cpp, *tmpcp;
{
  char *cp;
  
  
  /* Find first nonsymbol char */
  for(cp = *cpp = byspace(*cpp); issym(**cpp); (*cpp)++);
  
  /* Save and replace it with '\0' */
  *tmpcp = **cpp;
  **cpp = '\0';

  if(!*cp)
    sgnerr("Null symbol name");

  return(cp);
}


/* OPX: Test if symbol is defined */
struct val evdefd(cpp)
  char **cpp;
{
  int tmpi;
  char tmpc, *cp;
  SYM_NODE *symp;
  extern char *scansym();

  
  /* Scan symbol and look it up */
  *cpp = byspace(*cpp);
  cp = scansym(cpp, &tmpc);

  tmpi = (symp = sm_find_sym(symtbl, cp)) && !(symp->flags & F_UDF);
  
  /* Restore delimiter and return */
  cp[strlen(cp)] = tmpc;
  return(intval(tmpi));
}


/* OPX: Return current location */
struct val evloc0()
{
  return(intval(loc0));
}


/* OPX: Return current pass */
struct val evpass()
{
  extern pass;

  return(intval(pass));
}


/* OPX: Return running Kermit CRC */
struct val evkcrc()
{
  extern unsigned long kcrc;

  return(intval((INT) (kcrc & 0xffff)));
}


/* OPX: generate symbol */
struct val evgensym()
{
  extern char *expr_strdup();
  extern struct val strval();
  char symname[64];
  extern gensym_ctr;

  sprintf(symname, "L_%05u", gensym_ctr++);
  
  return(strval(expr_strdup(symname)));
}


/* OPX: return instance level of symbol */
struct val evinstances(cpp)
  char **cpp;
{
  char c, *name;
  int i;
  extern char *scansym();

  name = scansym(cpp, &c);
  i = instances(name);
    
  name[strlen(name)] = c;
  return(intval(i));
}


/* OPX: string */
struct val evstr(cpp)
  char **cpp;
{
  char *s;
  struct val v;

  (*cpp)--;			/* Back up to quote */
  v.type = VT_STR;
  v.vstr = str(cpp);

  return(v);
}


/* XOPY: return left portion of string */
struct val evleftstr(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  term1 = tostr(term1);
  term2 = toint(term2);

  if(term2.vint < 0 || term2.vint > strlen(term1.vstr))
    return(term1);

  term1.vstr[term2.vint] = '\0';
  return(term1);
}


/* XOPY: return right portion of string */
struct val evrightstr(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  term1 = tostr(term1);
  term2 = toint(term2);

  if(term2.vint < 0 || term2.vint > strlen(term1.vstr))
    return(term1);

  term1.vstr += term2.vint - 1;
  return(term1);
}


/* OPX: int to string by ascii value */
struct val evchartostr(cpp, term)
  char **cpp;
  struct val term;
{
  char buf[2];
  extern char *expr_strdup();

  term = toint(term);
  
  buf[1] = '\0';
  buf[0] = term.vint;

  term.vstr = expr_strdup(buf);
  term.type = VT_STR;

  return(term);
}


/* OPX string length */
struct val evstrlen(cpp, term)
  char **cpp;
  struct val term;
{
  term = tostr(term);

  term.vint = strlen(term.vstr);
  term.type = VT_INT;
  return(term);
}


/* OPX: trim leading spaces */
struct val evtrimld(cpp, term)
  char **cpp;
  struct val term;
{
  term = tostr(term);
  term.vstr = byspace(term.vstr);
  return(term);
}


/* OPX: trim trailing spaces */
struct val evtrimtr(cpp, term)
  char **cpp;
  struct val term;
{
  register char *cp;

  term = tostr(term);

  for(cp = term.vstr + strlen(term.vstr) - 1; cp >= term.vstr; cp--)
    if((unsigned char) *cp > ' ')
      {
	*++cp = '\0';
	return(term);
      }

  term.vstr[0] = '\0';
  return(term);
}


/* OPX: eval */
struct val eveval(cpp, term)
  char **cpp;
  struct val term;
{
  char *cp;

  /* All types except strings evaluate to themselves */
  if(term.type != VT_STR)
    return(term);

  cp = term.vstr;
  return(evexpr(&cp));
}


/* OPX: uppercase conversion */
struct val evuc(cpp, term)
  char **cpp;
  struct val term;
{
  extern struct val uppercase();

  return(uppercase(term));
}


/* OPX: Recursive assembly.
 * Should be recoded so it doesn't use goto's.
 */
struct val evinstr(cpp, term)
  char **cpp;
  struct val term;
{
  char
    *oldcodebuf, *oldcodeptr, *str, *tmp, tmpc, termc, *asnarg;
  int
    low, hi, center, old_codeblock = codeblock;
  SYM_NODE *symp;
  extern char
    *malloc(), codebuf[], *codeptr;
  extern struct istruct instbl[];
  extern
    hitlo[], hithi[], scmp(), symtop;
  

  if(term.type != VT_STR)
    return(toint(term));

  if(codeptr > codebuf)
    {
      oldcodebuf = malloc(codeptr-codebuf);
      bcopy(codebuf, oldcodebuf, codeptr-codebuf);
    }

  /* Block out code generation */
  codeblock = TRUE;

  oldcodeptr = codeptr;
  codeptr = codebuf;

  str = term.vstr;
  
  /* Extract first word */
  if(*(str = byspace(str)) == ';' || *str < '\040')
    {
      term = val_zero;
      goto restore_ret;
    }
  
  for(tmp = str; *str > ' ' && (str == tmp || *str != '.') && *str != '=';
      str++);

  termc = *str;
  *str = '\0';

  tmpc = toupper(*tmp)-32;
  
  /* Is it "name = expr"? */
  if(termc && (termc == '=' || *byspace(str+1) == '='))
    {
      char defstr[132];
      extern void ddef(), dorg();
      extern struct val val_nullstr, localize();

      static struct istruct
	defs = {"=", ddef, 0, 0},
	dorgs = {"=", dorg, 0, 0};

      if(tmp[0] == '.' && !tmp[1])
	{
	  sprintf(defstr, " %s", byspace(str + (termc == '=' ? 1 : 2)));
	  dorg(&dorgs, defstr);
	}
      else
	{
	  sprintf(defstr, " %s %s", tmp,
		  byspace(str + (termc == '=' ? 1 : 2)));
	  ddef(&defs, defstr);
	}

      *str = termc;
      term = localize(val_nullstr);
      goto restore_ret;
    }

  /* Expand if macro */
  if((symp = sm_find_sym(symtbl, tmp)) && symp->value.type == VT_MAC)
    {
      *str = termc;
      expand_macro(symp->value.vmacro, byspace(str));
      goto return_codebuf;
    }

  /* Look it up in the instruction table */
  if((low = hitlo[tmpc]) >= 0 && low <= symtop)
    for(hi = hithi[tmpc]; hi >= low;)
      switch(scmp(tmp, instbl[center = (hi + low) >> 1].name))
	{		/* Aim */
	case -1:	/* Hi  */	hi  = center-1; break;
	case 1:		/* Low */	low = center+1; break;
	default:	/* Eq  */	goto found;
	}
  
  /* Not a macro or instruction */
  sgnerr("Undefined instruction or macro - `%s'", tmp);
  goto return_codebuf;
  
  /* Instruction found */
 found:
  
  /* Restore string */
  *str = termc;

  /* Translate operands and generate code */
  (*instbl[center].scandef)(&instbl[center], str);

 return_codebuf:

  /* Restore old codebuf and return new, low-endian */
  term.type = VT_INT;
  term.vint = 0;

  while(codeptr-- > codebuf)
    {
      term.vint <<= 4;
      term.vint |= (unsigned char) *codeptr;
    }

 restore_ret:
  
  if(oldcodeptr > codebuf)
    {
      bcopy(oldcodebuf, codebuf, oldcodeptr-codebuf);
      free(oldcodebuf);
    }

  codeblock = old_codeblock;
  codeptr = oldcodeptr;
  return(term);
}


/* OPX: Recursive assembly.
 * Should be recoded so it doesn't use goto's.
 *
 * Same as evinstr(), but returns number of nibbles instead.
 * The code here should be generalized with assemble_line() and
 * expand_body() as well as evinstr().
 */
struct val evinstrlen(cpp, term)
  char **cpp;
  struct val term;
{
  char
    *oldcodebuf, *oldcodeptr, *str, *tmp, tmpc, termc, *asnarg;
  int
    low, hi, center, old_codeblock = codeblock;
  SYM_NODE *symp;
  extern char
    *malloc(), codebuf[], *codeptr;
  extern struct istruct
    instbl[];
  extern
    hitlo[], hithi[], scmp(), symtop;
  

  if(term.type != VT_STR)
    return(toint(term));

  if(codeptr > codebuf)
    {
      oldcodebuf = malloc(codeptr-codebuf);
      bcopy(codebuf, oldcodebuf, codeptr-codebuf);
    }

  /* Block out code generation */
  codeblock = TRUE;

  oldcodeptr = codeptr;
  codeptr = codebuf;

  str = term.vstr;
  
  /* Extract first word */
  if(*(str = byspace(str)) == ';' || *str < '\040')
    {
      term = val_zero;
      goto restore_ret;
    }
  
  for(tmp = str; *str > ' ' && (str == tmp || *str != '.') && *str != '=';
      str++);

  termc = *str;
  *str = '\0';

  tmpc = toupper(*tmp)-32;
  
  /* Is it "name = expr"? */
  if(termc && (termc == '=' || *byspace(str+1) == '='))
    {
      char defstr[132];
      extern void ddef(), dorg();
      extern struct val val_nullstr, localize();

      static struct istruct
	defs = {"=", ddef, 0, 0},
	dorgs = {"=", dorg, 0, 0};

      if(tmp[0] == '.' && !tmp[1])
	{
	  sprintf(defstr, " %s", byspace(str + (termc == '=' ? 1 : 2)));
	  dorg(&dorgs, defstr);
	}
      else
	{
	  sprintf(defstr, " %s %s", tmp,
		  byspace(str + (termc == '=' ? 1 : 2)));
	  ddef(&defs, defstr);
	}

      *str = termc;
      term = localize(val_zero);
      goto restore_ret;
    }

  /* Expand if macro */
  if((symp = sm_find_sym(symtbl, tmp)) && symp->value.type == VT_MAC)
    {
      *str = termc;
      expand_macro(symp->value.vmacro, byspace(str));
      goto return_codebuf;
    }

  /* Look it up in the instruction table */
  if((low = hitlo[tmpc]) >= 0 && low <= symtop)
    for(hi = hithi[tmpc]; hi >= low;)
      switch(scmp(tmp, instbl[center = (hi + low) >> 1].name))
	{		/* Aim */
	case -1:	/* Hi  */	hi  = center-1; break;
	case 1:		/* Low */	low = center+1; break;
	default:	/* Eq  */	goto found;
	}
  
  /* Not a macro or instruction */
  sgnerr("Undefined instruction or macro - `%s'", tmp);
  goto return_codebuf;
  
  /* Instruction found */
 found:
  
  /* Restore string */
  *str = termc;

  /* Translate operands and generate code */
  (*instbl[center].scandef)(&instbl[center], str);

 return_codebuf:

  /* Restore old codebuf and return new, low-endian */
  term.type = VT_INT;
  term.vint = 0;

  term.vint = codeptr - codebuf;

 restore_ret:
  
  if(oldcodeptr > codebuf)
    {
      bcopy(oldcodebuf, codebuf, oldcodeptr-codebuf);
      free(oldcodebuf);
    }

  codeptr = oldcodeptr;
  return(term);
}


/* OPX: Return type */
struct val evtype(cpp, term)
  char **cpp;
  struct val term;
{
  return(intval((INT) term.type));
}


/* XOPY: power */
struct val evpow(cpp, term1, term2)
  char **cpp;
  struct val term1, term2;
{
  return(realval(pow((double) toreal(term1).vdouble,
		     (double) toreal(term2).vdouble)));
}


struct stdent {
  double (*stdfun)();		/* Function */
  int enabled;			/* Enabled on this system */
}
ftable[] = {
  {acos, TRUE}, {asin, TRUE},
  {atan, TRUE}, {ceil, TRUE}, {cos, TRUE}, {cosh, TRUE},
  {exp, TRUE}, {fabs, TRUE}, {floor, TRUE}, {fmod, TRUE},
  {log, TRUE}, {log10, TRUE}, {sin, TRUE}, {sinh, TRUE},
  {sqrt, TRUE}, {tan, TRUE}, {tanh, TRUE}};


/* OPX: standard functions */
struct val evfun(cpp, term)
  char **cpp;
  struct val term;
{
  int nthfun;
  extern struct fstruct *fhit;
  extern struct val val_real0;
  
  nthfun = fhit->auxval;
  if(!ftable[nthfun].enabled)
    {
      sgnerr("Function `%s' not supported on this system", fhit->name);
      return(val_real0);
    }

#ifdef MSDOS
  {
    REAL ret1 = (*ftable[nthfun].stdfun)((double) toreal(term).vdouble);
    return(realval(ret1));
  }
#else
  return(realval((REAL)
		 (*ftable[nthfun].stdfun)((double) toreal(term).vdouble)));
#endif
}


/* OPX: real to bin */
struct val evrtobin(cpp, term)
  char **cpp;
  struct val term;
{
  struct val v;
  INT i = 0;
  int xs, digit;
  term = toreal(term);


  /* Sign nibble */
  i = (v.vdouble < 0.0 ? 9 : 0);

  xs = EXPONENT(v.vdouble);

  /* Mantissa */
  v.vdouble /= pow(10.0, (REAL) xs);

  if(v.vdouble < 0.0)
    v.vdouble = -v.vdouble;

  for(digit = 0; digit < 12; digit++)
    {
      i <<= 4;
      i += (INT) floor(v.vdouble = fmod(v.vdouble, 10.0));
      v.vdouble *= 10.0;
    }

  /* Exponent */
  i <<= 12;

  if(xs >= 0)
    i |= (xs & 0xfff);
  else
    {
      int axs = -xs;
      i |= (0x99a -
	    (((axs / 100) << 8) |
	     (((axs / 10) % 10) << 4) |
	     (axs % 10))) & 0xfff;
    }

  v.type = VT_INT;
  v.vint = i;
  return(v);
}
  

/* OPX: Pooled Literal */
struct val evliteral(cpp, term)
  char **cpp;
  struct val term;
{
  char
    *oldcodebuf, *oldcodeptr, *str, *tmp, tmpc, termc, *asnarg;
  int
    low, hi, center;
  SYM_NODE *symp;
  long
    save_loc = loc, save_loc0 = loc0;
  extern char
    *malloc(), codebuf[], *codeptr;
  extern struct istruct
    instbl[];
  extern
    hitlo[], hithi[], scmp(), symtop, pass;


  term = tostr(term);
  
  if(codeptr > codebuf)
    {
      oldcodebuf = malloc(codeptr-codebuf);
      bcopy(codebuf, oldcodebuf, codeptr-codebuf);
    }

  oldcodeptr = codeptr;
  codeptr = codebuf;

  str = term.vstr;
  
  /* Extract first word */
  if(*(str = byspace(str)) == ';' || *str < '\040')
    {
      term = val_zero;
      goto restore_ret;
    }
  
  for(tmp = str; *str > ' ' && (str == tmp || *str != '.') && *str != '=';
      str++);

  termc = *str;
  *str = '\0';

  tmpc = toupper(*tmp)-32;
  
  /* Is it "name = expr"? */
  if(termc && (termc == '=' || *byspace(str+1) == '='))
    {
      sgnerr("Invalid literal");
      term = intval(add_literal(codebuf, 0));
      goto restore_ret;
    }

  /* Expand if macro */
  if((symp = sm_find_sym(symtbl, tmp)) && symp->value.type == VT_MAC)
    {
      *str = termc;
      expand_macro(symp->value.vmacro, byspace(str));
      goto return_litaddr;
    }

  /* Look it up in the instruction table */
  if((low = hitlo[tmpc]) >= 0 && low <= symtop)
    for(hi = hithi[tmpc]; hi >= low;)
      switch(scmp(tmp, instbl[center = (hi + low) >> 1].name))
	{		/* Aim */
	case -1:	/* Hi  */	hi  = center-1; break;
	case 1:		/* Low */	low = center+1; break;
	default:	/* Eq  */	goto found;
	}
  
  /* Not a macro or instruction */
  sgnerr("Undefined instruction or macro - `%s'", tmp);

  term = val_zero;
  goto restore_ret;
  
  /* Instruction found */
 found:
  
  /* Restore string */
  *str = termc;

  /* Translate operands and generate code */
  (*instbl[center].scandef)(&instbl[center], str);


  /* Add code to literal pool and return address */

 return_litaddr:

  loc0 = save_loc0;
  loc  = save_loc;

  term.type = VT_INT;
  term.vint = add_literal(codebuf, codeptr-codebuf);
  

  /* Restore codebuf and return */

 restore_ret:
  
  loc0 = save_loc0;
  loc  = save_loc;

  if(oldcodeptr > codebuf)
    {
      bcopy(oldcodebuf, codebuf, oldcodeptr-codebuf);
      free(oldcodebuf);
    }

  codeptr = oldcodeptr;
  return(term);
}


/* OPX: Test if symbol is LIBCALLed
 */
struct val evused(cpp)
  char **cpp;
{
  char *cp, tmpc;
  SYM_NODE *tmps;
  extern char *scansym();

  
  /* Scan symbol and look it up */
  *cpp = byspace(*cpp);
  cp = scansym(cpp, &tmpc);

  if(!(tmps = sm_find_sym(symtbl, cp)))
    return(val_zero);
  
  /* Return status */
  return(intval((tmps->flags & F_USED) != 0));
}
