/*****************************************************************************/
/*                                                                           */
/*                               M O U S E                                   */
/*                                                                           */
/*  Program:      MOUSE                                                      */
/*                                                                           */
/*  Programmer:   David G. Simpson                                           */
/*                Laurel, Maryland                                           */
/*                February 3, 2002                                           */
/*                                                                           */
/*  Language:     C                                                          */
/*                                                                           */
/*  Description:  This is an interpreter for the Mouse-2002 programming      */
/*                language.                                                  */
/*                                                                           */
/*  Version:      19  (April 1, 2007)                                        */
/*                                                                           */
/*  Notes:        This interpreter is based on the original Pascal           */
/*                implementation in "Mouse: A Language for Microcomputers"   */
/*                by Peter Grogono.                                          */
/*                                                                           */
/*                Syntax:   MOUSE  <filename>                                */
/*                                                                           */
/*                If no file extension is given, an extension of ".mou" is   */
/*                assumed.                                                   */
/*                                                                           */
/*****************************************************************************/

/*****************************************************************************/
/*  #includes                                                                */
/*****************************************************************************/

#include <stdio.h>                          /* standard i/o                  */
#include <stdlib.h>                         /* standard library              */
#include <string.h>                         /* string functions              */
#include <ctype.h>                          /* character functions           */
#include <math.h>                           /* mathematical functions        */
#include <time.h>                           /* time functions                */



/*****************************************************************************/
/*  #defines                                                                 */
/*****************************************************************************/

#define  MAXPROGLEN   10000                 /* max length of Mouse program   */
#define  MAXPROGLINELEN 132                 /* max length of interactive line*/
#define  STACKSIZE     1024                 /* maximum depth of calc stack   */
#define  ENVSTACKSIZE  1024                 /* maximum depth of env stack    */
#define  LOCSIZE         26                 /* size of local variable space  */
#define  MAXADDR       1300                 /* 50 local variable spaces      */
#define  HALFWIDTH       39                 /* a number < half screen width  */
#define  MOUSE_EXT    ".mou"                /* default source file extension */
#define  ARRAYSIZE     1000                 /* size of universal array       */
#define  MAXFILES        10                 /* max number of files open      */

#define  BACKSPACE     charpos--            /* backspace one char in program */
#define  VALUE(digit)  (digit - '0')        /* convert char to corresp digit */
#define  UPPERCASE     ch = toupper(ch)     /* convert ch to uppercase       */

#define  TOLERANCE     1.0e-6

#ifndef  PI
#define  PI  3.14159265358979323846264338327950288419716939937510582097494459230
#endif

#define  SPEED_OF_LIGHT  299792458.0                   /* m/s                */
#define  ELEMENTARY_CHG  1.60217653e-19                /* C                  */
#define  GRAV_ACCEL      9.80665                       /* m s**-2            */
#define  GRAV_CONST      6.6742e-11                    /* m**3 kg**-1 s**-2  */
#define  PLANCK          6.6260693e-34                 /* J s                */
#define  H_BAR           1.05457168e-34                /* J s                */
#define  PERMEABILITY    (4.0e-7*PI)                   /* N A**-2            */
#define  PERMITTIVITY    (1.0/(PERMEABILITY*SPEED_OF_LIGHT*SPEED_OF_LIGHT))
#define  MASS_ELECTRON   9.1093826e-31                 /* kg                 */
#define  MASS_PROTON     1.67262171e-27                /* kg                 */
#define  MASS_NEUTRON    1.67492728e-27                /* kg                 */
#define  AVAGADRO        6.0221415e23                  /* mol**-1            */
#define  BOLTZMANN       1.3806505e-23                 /* J/K                */

#define  AU              1.49597870e11                 /* m                  */
#define  GM_EARTH        3.9860005e14                  /* m**3 s**-2         */
#define  GM_SUN          1.32712438e20                 /* m**3 s**-2         */
#define  R_EARTH         6.378140e6                    /* m                  */

#define  LB_KG           0.45359237
#define  IN_CM           2.54
#define  GAL_L           3.7854118


#define  DEFAULT_ANGLE_FACTOR    1.0
#define  DEFAULT_DISPLAY_MODE    2
#define  DEFAULT_DISPLAY_DIGITS  15
#define  DEFAULT_DISPLAY_WIDTH   0
#define  DEFAULT_WORDSIZE        32
#define  DEFAULT_OCTHEX_DIGITS   ((DEFAULT_WORDSIZE-1)/4+1)

#define  VERSION         19
#define  PROMPT          "\n> "


/*****************************************************************************/
/*  type definitions                                                         */
/*****************************************************************************/

enum  tagtype {macro, parameter, loop};     /* tag type for environmnt stack */

typedef struct {                            /* environment stack entry type  */
   enum tagtype  tag;                       /* type of entry                 */
   long     charpos;                        /* instruction pointer           */
   long     offset;                         /* variable offset level         */
   } environment;



/*****************************************************************************/
/*  global variables                                                         */
/*****************************************************************************/

FILE         *progfile;                     /* pointer to Mouse source file  */

char         prog[MAXPROGLEN];              /* array to hold program         */
char         prog_line[MAXPROGLINELEN+2];
double       stack[STACKSIZE];              /* calculation stack             */
environment  envstack[ENVSTACKSIZE];        /* environment stack             */
double       data[MAXADDR];                 /* variables                     */
long         macdefs[26];                   /* macro definitions             */

char         ch;                            /* current character in program  */
long         charpos;                       /* instruction pointer           */
long         proglen;                       /* total length of program code  */
long         sp;                            /* calculation stack pointer     */
long         esp;                           /* environment stack pointer     */
long         tsp;                           /* temporary stack pointer       */
long         offset;                        /* variable offset               */
long         nextfree;                      /* next free variable address    */
double       temp, temp2, temp3;            /* temporary doubles             */
long         itemp, itemp2;                 /* temporary integers            */
long         parbal;                        /* matches pairs in env stack    */
long         parnum;                        /* macro parameter number        */
int          tracing;                       /* tracing on/off flag           */
int          disaster;                      /* disaster flag; 1=disaster     */
int          j;                             /* loop index                    */
char         filename[101];                 /* Mouse source file name        */
char         format_str[11];                /* printf format string          */
long         ntemp;                         /* temporary integer             */
int          done;                          /* 1=exit interactive mode       */
char         line[133];                     /* input line                    */
int          source;                        /* 0=compile, 1=interactive      */
double       array[ARRAYSIZE];              /* array for &sto and &rcl       */
int          error_flag;                    /* error flag                    */
FILE         *fp[MAXFILES];                 /* array of file pointers        */
char         filename_str[13];              /* i/o filename                  */
char         filenum_str[4];                /* file numbers string (000-999) */
char         filemode_str[3];               /* file mode string (r,w,rb,wb)  */
char         temp_str[25];                  /* temporary string              */
enum tagtype envtag;                        /* tag from environment stack    */

double       angle_factor = DEFAULT_ANGLE_FACTOR;      /* "to radians" factor*/
long         display_mode = DEFAULT_DISPLAY_MODE;      /* 0=fix, 1=sci, 2=gen*/
long         display_digits = DEFAULT_DISPLAY_DIGITS;  /* #digits to show    */
long         display_width = DEFAULT_DISPLAY_WIDTH;    /* print width        */
long         wordsize = DEFAULT_WORDSIZE;              /* word size (bits)   */
long         octhex_digits = DEFAULT_OCTHEX_DIGITS;    /* octal/hex digits   */
long         octhex_mask = 0xFFFFFFFF;                 /* octal/hex mask     */


/*****************************************************************************/
/*  function prototypes                                                      */
/*****************************************************************************/

void chomp (char *str);                     /* remove final \n from a string */
void display (long charpos);                /* display an environment        */
void error (short code);                    /* report error; stop interpreter*/
void Getchar(void);                         /* get next character in program */
void push (double datum);                   /* push item onto calc stack     */
double pop (void);                          /* pop item from calc stack      */
void skipstring(void);                      /* skip over a string            */
void skip (char lch, char rch);             /* skip bracketed sequences      */
void skip2 (char lch, char rch1,char rch2); /* skip bracketed sequences      */
void pushenv (enum tagtype tag);            /* push an environment on env stk*/
void popenv (void);                         /* pop an environmnt from env stk*/
void load (void);                           /* loader: loads program code    */
void makedeftable (void);                   /* create macro definition table */
void interpret (void);                      /* interpreter: runs program code*/
void process_amp(char *str);                /* process & functions           */
double Int (double f);                      /* integer part                  */
double Frac (double f);                     /* fractional part               */
long round(double x);                       /* round to nearest integer      */







/*****************************************************************************/
/*                                                                           */
/*  main()                                                                   */
/*                                                                           */
/*****************************************************************************/

int main (int argc, char *argv[])
{
/*---------------------------------------------------------------------------*/
/*  Check command-line arguments.                                            */
/*---------------------------------------------------------------------------*/

if (argc == 1)                              /* check for 1 cmd line argument */
   {
   source = 1;
   done = 0;
   printf("Mouse-2002 Interpreter Version %d\n", VERSION);
   sp = -1;                                 /* init stack pointer            */
   esp = -1;                                /* init environ stack pointer    */
   do {
      printf(PROMPT);
      fgets(line,132,stdin);
      load();
      interpret();
      } while (!done);
   exit(0);                                 /* and return to oper system     */
   }


/*---------------------------------------------------------------------------*/
/*  If not interactive mode (source from file), set source flag to 0.        */
/*---------------------------------------------------------------------------*/

source = 0;


/*---------------------------------------------------------------------------*/
/*  If no file extension given, add the default extension to filename.       */
/*---------------------------------------------------------------------------*/

strcpy(filename, argv[1]);                  /* copy cmd line argument        */
if (strchr(filename, (int)'.') == NULL)     /* if no file extension given..  */
   strcat(filename, MOUSE_EXT);             /* ..append default extension    */


/*---------------------------------------------------------------------------*/
/*  Open mouse source file.                                                  */
/*---------------------------------------------------------------------------*/

if ((progfile=fopen(filename,"rb"))==NULL)  /* open Mouse source file        */
   {
   printf("Error opening file %s\n",        /* if open error, print err msg  */
          filename);
   exit(1);                                 /* and return to operating sys   */
   }

/*---------------------------------------------------------------------------*/
/*  Load Mouse source file into memory, then close the source file.          */
/*---------------------------------------------------------------------------*/

load();                                     /* load program into memory      */
fclose(progfile);                           /* close Mouse source file       */

/*---------------------------------------------------------------------------*/
/*  If load went OK, then define macros and run the interpreter.             */
/*---------------------------------------------------------------------------*/

if (!disaster)                              /* if no load problems..         */
   {
   makedeftable();                          /* create macro definition table */
   interpret();                             /* and run interpreter           */
   }

/*---------------------------------------------------------------------------*/
/*  All done.  Return to operating system.                                   */
/*---------------------------------------------------------------------------*/

return 0;                                   /* return to operating system    */

}                                           /* end MouseInterpreter          */






/*****************************************************************************/
/*                                                                           */
/*  display()                                                                */
/*                                                                           */
/*  Display an environment; used for reporting errors and tracing.           */
/*  This routine displays a line of code centered on the given pointer, with */
/*  a ^ pointing to the character at the pointer.                            */
/*                                                                           */
/*****************************************************************************/

void display (long charpos)
{
long  pos;                                  /* loop index                    */
char  *prog_ptr;


if (source == 0)
   prog_ptr = prog;
else
   prog_ptr = prog_line;

for (j=0; j<4; j++)                         /* print stack                   */
   {
   if (j > sp)
      printf("  ..........");
   else
      printf("%12.4e", stack[sp-j]);
   }
printf("      ");

for (pos = charpos - HALFWIDTH;             /* for HALFWIDTH chars centered..*/
     pos <= charpos + HALFWIDTH; pos++)     /*..on current position..        */
   {
   if ((pos >= 0) && (pos < proglen)        /* if within program bounds..    */
              && (prog_ptr[pos] >= ' '))    /*..and printable character..    */
      printf("%c", prog_ptr[pos]);          /* print program character       */
   else                                     /* otherwise,                    */
      printf(" ");                          /* just print a space            */
   }

printf ("\n");                              /* end of line                   */
for (j=0; j<HALFWIDTH+54; j++)              /* print spaces to position ^    */
   printf(" ");
printf("^\n");                              /* print ^ pointer               */
}                                           /* end display                   */





/*****************************************************************************/
/*                                                                           */
/*  error()                                                                  */
/*                                                                           */
/*  Report an error and set "disaster" flag to stop the interpreter.         */
/*                                                                           */
/*****************************************************************************/

void error (short code)
{
short  tsp;                                 /* loop counter                  */


printf("\nEnvironment:\n");                 /* start new line                */
for (tsp = 0; tsp < esp; tsp++)             /* for each entry in env stack.. */
   display(envstack[tsp].charpos);          /* display the code at that entry*/

printf("Instruction pointer:\n");           /* display code at instruct ptr  */
display(charpos);

printf("Stack:");                           /* display stack contents        */
for (tsp = 0; tsp <= sp; tsp++)
   printf(" [%17.10E] ", stack[tsp]);
printf("\n");

printf ("***** Error %d: ", code);          /* print error message           */
switch (code)                               /* select err message from list  */
   {
   case  1 : printf("Ran off end of program");            break;
   case  2 : printf("Calculation stack overflowed");      break;
   case  3 : printf("Calculation stack underflowed");     break;
   case  4 : printf("Attempted to divide by zero");       break;
   case  5 : printf("Attempted to find modulus by zero"); break;
   case  6 : printf("Undefined macro");                   break;
   case  7 : printf("Illegal character follows \"#\"");   break;
   case  8 : printf("Environment stack overflowed");      break;
   case  9 : printf("Environment stack underflowed");     break;
   case 10 : printf("Data space exhausted");              break;
   case 11 : printf("Illegal character %d", ch);          break;
   case 12 : printf("Invalid argument for &acos");        break;
   case 13 : printf("Invalid argument for &acosh");       break;
   case 14 : printf("Invalid argument for &asin");        break;
   case 15 : printf("Invalid argument for &atanh");       break;
   case 16 : printf("Invalid argument for &ln");          break;
   case 17 : printf("Invalid argument for &log2");        break;
   case 18 : printf("Invalid argument for &log10");       break;
   case 19 : printf("Invalid argument for &recip");       break;
   case 20 : printf("Invalid argument for &sqrt");        break;
   case 21 : printf("Invalid argument for &!");           break;
   case 22 : printf("Invalid word size");                 break;
   case 23 : printf("Invalid arguments for &cnr");        break;
   case 24 : printf("Invalid arguments for &pnr");        break;
   case 25 : printf("Array index out of bounds");         break;
   case 26 : printf("Invalid argument for ` or &power");  break;
   case 27 : printf("Invalid arguments for &root");       break;
   case 28 : printf("Error opening file");                break;
   case 29 : printf("Invalid & function name");           break;
   case 30 : printf("Invalid argument for &cubert");      break;
   case 31 : printf("Invalid argument for &4thrt");       break;
   }  /* end case */
printf("\n");
disaster = 1;                               /* set disaster flag             */
sp = -1;                                    /* clear stack                   */
}                                           /* end error                     */





/*****************************************************************************/
/*                                                                           */
/*  Getchar()                                                                */
/*                                                                           */
/*  Get next character from program buffer and check for end of program.     */
/*                                                                           */
/*****************************************************************************/

void Getchar(void)
{
if (charpos < proglen-1)                    /* if next chr is within program */
   {
   charpos++;                               /* increment instruction pointer */
   if (source == 0)
      ch = prog[charpos];                   /* put next char into ch         */
   else
      ch = prog_line[charpos];
   }
else                                        /* else ran off end of program   */
   error(1);                                /* print error message           */
}                                           /* end Getchar                   */





/*****************************************************************************/
/*                                                                           */
/*  push()                                                                   */
/*                                                                           */
/*  Push an item onto the calculation stack and check for stack overflow.    */
/*                                                                           */
/*****************************************************************************/

void push (double datum)
{
if (sp < STACKSIZE-1)                       /* if enough room on calc stack..*/
   {
   sp++;                                    /* increment stack pointer       */
   stack[sp] = datum;                       /* store data item on stack      */
   }
else                                        /* else calc stack filled up     */
   error(2);                                /* print error message           */
}                                           /* end push                      */





/*****************************************************************************/
/*                                                                           */
/*  pop()                                                                    */
/*                                                                           */
/*  Pop an item from the calculation stack; check for underflow.             */
/*                                                                           */
/*****************************************************************************/

double pop (void)
{
double result;                              /* returned stack value          */

if (sp >= 0)                                /* if an item is avail on stack..*/
   {
   result = stack[sp];                      /* get value on top of stack     */
   sp--;                                    /* decrement stack pointer       */
   }
else                                        /* otherwise stack underflow     */
   error(3);                                /* print error message           */
return result;
}                                           /* end pop                       */





/*****************************************************************************/
/*                                                                           */
/*  skipstring()                                                             */
/*                                                                           */
/*  Skip over a string; " has been scanned on entry.                         */
/*                                                                           */
/*****************************************************************************/

void skipstring(void)
{
do {                                        /* do until we find ending "     */
   Getchar();                               /* read program character        */
   } while (ch != '"');                     /* stop when ending " found      */
}                                           /* end skipstring                */





/*****************************************************************************/
/*                                                                           */
/*  skip()                                                                   */
/*                                                                           */
/*  Skip bracketed sequences; lch has been scanned on entry.                 */
/*                                                                           */
/*****************************************************************************/

void skip (char lch, char rch)
{
short  count;                               /* counter used for matching     */

count = 1;                                  /* one bracket already read      */
do {                                        /* do until matching end bracket */
   Getchar();                               /* read program character        */
   if (ch == '"')                           /* if it starts a string..       */
      skipstring();                         /* ..then skip to end of string  */
   else if (ch == lch)                      /* if another 'left' character.. */
      count++;                              /* ..then increment counter      */
   else if (ch == rch)                      /* if closing 'right' character..*/
      count--;                              /* ..then decrement counter      */
   } while (count != 0);                    /* repeat until matching right ch*/
}                                           /* end skip                      */





/*****************************************************************************/
/*                                                                           */
/*  skip2()                                                                  */
/*                                                                           */
/*  Skip bracketed sequences; lch has been scanned on entry.                 */
/*  End bracket is either rch1 or rch2.                                      */
/*                                                                           */
/*****************************************************************************/

void skip2 (char lch, char rch1, char rch2)
{
short  count;                               /* counter used for matching     */

count = 1;                                  /* one bracket already read      */
do {                                        /* do until matching end bracket */
   Getchar();                               /* read program character        */
   if (ch == '"')                           /* if it starts a string..       */
      skipstring();                         /* ..then skip to end of string  */
   else if (ch == lch)                      /* if another 'left' character.. */
      count++;                              /* ..then increment counter      */
   else if (ch == rch1 || ch == rch2)       /* if closing 'right' character..*/
      count--;                              /* ..then decrement counter      */
   } while (count != 0);                    /* repeat until matching right ch*/
}                                           /* end skip                      */





/*****************************************************************************/
/*                                                                           */
/*  pushenv()                                                                */
/*                                                                           */
/*  Push an environment; check for environment stack overflow.               */
/*                                                                           */
/*****************************************************************************/

void pushenv (enum tagtype tag)
   {
if (esp < ENVSTACKSIZE-1)                   /* if room avail on env stack..  */
   {
   esp++;                                   /* ..increment env stack pointer */
   envstack[esp].tag = tag;                 /* save tag type                 */
   envstack[esp].charpos = charpos;         /* save instruction pointer      */
   envstack[esp].offset = offset;           /* save variable offset          */
   }
else                                        /* otherwise, env stack overflow */
   error(8);                                /* print error message           */
}                                           /* end pushenv                   */





/*****************************************************************************/
/*                                                                           */
/*  popenv()                                                                 */
/*                                                                           */
/*  Pop an environment; check for environment stack underflow.               */
/*                                                                           */
/*****************************************************************************/

void popenv(void)
{
if (esp >= 0)                               /* if item avail on env stack..  */
   {
   envtag = envstack[esp].tag;              /* pop tag type                  */
   charpos = envstack[esp].charpos;         /* pop instruction pointer       */
   offset = envstack[esp].offset;           /* pop variable offset           */
   esp--;                                   /* decrement stack pointer       */
   }
else                                        /* otherwise stack underflow     */
   error(9);                                /* print error message           */
}                                           /* end popenv                    */





/*****************************************************************************/
/*                                                                           */
/*  load()                                                                   */
/*                                                                           */
/*  The Loader.                                                              */
/*  This version of the loader has been optimized to remove all spaces       */
/*  except for spaces within strings and spaces separating numbers (for      */
/*  which all but one space is removed).  It also eliminates all CR/LF       */
/*  characters.  Optimizing the loader to eliminate all unnecessary          */
/*  characters greatly improves the execution speed of the interpreter.      */
/*                                                                           */
/*****************************************************************************/

void load (void)
{
char  lastchr;                              /* previously loaded character   */
char  in = 0;                               /* 1=within a string             */
char  in_amp = 0;                           /* 1 = processing & string       */
char  *p;
char  *prog_ptr;
long  maxlen;


if (source == 0)
   {
   for (charpos = 0; charpos<MAXPROGLEN;    /* init entire program array..   */
     charpos++)
       prog[charpos] = ' ';                 /* ..to all spaces               */
   rewind(progfile);                        /* position to beginning of file */
   prog_ptr = prog;
   maxlen = MAXPROGLEN;
   }
else
   {
   p = line;
   prog_ptr = prog_line;
   maxlen = MAXPROGLINELEN;
   }
charpos = -1;                               /* init ptr to start of memory   */
disaster = 0;                               /* clear disaster flag           */
ch = '~';                                   /* init first character to ~     */
while (!disaster)                           /* while loading OK..            */
   {
   lastchr = ch;                            /* save previously loaded char   */
   if (source == 0)
      {
      fread(&ch, 1, 1, progfile);           /* read one char from Mouse file */
      if (feof(progfile))                   /* if end of Mouse file..        */
         break;                             /* then break out of loop        */
      }
   else
      {
      ch = *p++;
      if (ch=='\0' || ch=='\n')
         break;
      }
   if (ch == '~')                           /* if start of comment..         */
      {
      if (source == 0)
         do {
            fread(&ch, 1, 1, progfile);     /* ..read characters..           */
            } while (ch != '\n');           /* ..until next newline          */
      else
         break;
      }
   else if (charpos < maxlen-1)             /* else if program memory left.. */
      {
      charpos++;                            /* increment pointer to memory   */
      prog_ptr[charpos] = ch;               /* save read character to memory */
      if (ch == '\"')                       /* if current char is " ..       */
         in = !in;                          /* ..then toggle quote flag      */
      if (ch=='&' && !in)                   /* if current char is & ..       */
         in_amp = 1;                        /* ..then set & processing flag  */
      if (ch==10 || ch==13 || ch=='\n'      /* if CR or LF or newline..      */
          || ch=='\t' || ch=='\r')          /* ..or tab or \r..              */
         prog_ptr[charpos] = ch = ' ';      /* ..replace with space          */
      if (in_amp && ch==' ')                /* if end of & string..          */
         {
         prog_ptr[charpos] = ch = '&';      /* ..replace final space w/ &    */
         in_amp = 0;                        /* turn off & processing flag    */
         }
      if (in_amp && ch==';')                /* if end of & string (found ;)  */
         {
         prog_ptr[charpos] = ch = '&';      /* ..insert final & correctly    */
         charpos++;
         prog_ptr[charpos] = ch = ';';
         in_amp = 0;                        /* turn off & processing flag    */
         }
      if (ch==' ' && !in &&                 /* if a space not in string..    */
           !isdigit(lastchr) &&             /* ..and not after a number..    */
           (lastchr != '\''))               /* ..and not after a '..         */
         {
         charpos--;                         /* then backspace pointer        */
         ch = prog_ptr[charpos];            /* update last read character    */
         }
      else if (!in && lastchr == ' ' &&     /* if last char was a space and..*/
            !isdigit(ch) && ch != '\"'      /*..this char isn't a digit..    */
            && prog_ptr[charpos-2] != '\'') /*..and it isn't a quote-space.. */
         prog_ptr[--charpos] = ch;          /* then remove the last space    */
      }
   else                                     /* if no program memory left..   */
      {
      printf("Program is too long\n");      /* print error message           */
      disaster = 1;                         /* and set disaster flag         */
      }
   }                                        /* end while                     */
proglen = charpos + 1;                      /* set total program length      */
if (source==1)
   {
   prog_ptr[charpos+1] = '$';
   charpos++;
   proglen = charpos + 1;
   }

}                                           /* end load                      */





/*****************************************************************************/
/*                                                                           */
/*  makedeftable()                                                           */
/*                                                                           */
/*  Construct macro definition table.                                        */
/*                                                                           */
/*****************************************************************************/

void makedeftable (void)
{
for (ch = 'A' ; ch <= 'Z'; ch++)            /* for all macro table entries.. */
   macdefs[ch-'A'] = 0;                     /*..initialize all entries to 0  */
charpos = -1;                               /* init ptr to start of memory   */
do {                                        /* for all program characters    */
   Getchar();                               /* read next program character   */
   if (ch=='$' && charpos < proglen-1)      /* if this is a $ (macro defn..  */
      {                                     /* ..or end of program           */
      Getchar();                            /* read next char (macro letter) */
      UPPERCASE;                            /* convert it to uppercase       */
      if ((ch >= 'A') && (ch <= 'Z'))       /* if it's a macro definition..  */
         macdefs[ch-'A'] = charpos;         /* save pointer in macro def tbl */
      }
   } while (charpos < proglen-1);           /* repeat until end of program   */
}                                           /* end makedeftable              */





/*****************************************************************************/
/*                                                                           */
/*  interpret()                                                              */
/*                                                                           */
/*  The Interpreter.                                                         */
/*                                                                           */
/*****************************************************************************/

void interpret (void)
{
char         amp_str[11];                   /* & function string             */
char         *p;                            /* character pointer             */
char instr[26];                             /* input string                  */


charpos = -1;                               /* init instruction pointer      */
if (source==0)
   {
   sp = -1;                                 /* init stack pointer            */
   esp = -1;                                /* init environ stack pointer    */
   }
offset = 0;                                 /* init variable offset          */
nextfree = LOCSIZE;                         /* init next free variable addr  */

do {                                        /* repeat until end of program   */
   Getchar();                               /* read next program character   */
   if (ch == ' ')                           /* if it's a space..             */
      continue;                             /* ..skip to end of loop         */

   if (tracing)                             /* if tracing on..               */
      display(charpos);                     /* ..display code w/ curr posn   */

   if (isdigit(ch))                         /* if char is a digit..          */
      {                                     /* ..encode a decimal number     */
      temp = 0;                             /* init decimal number to 0      */
      while (isdigit(ch))                   /* repeat for each digit         */
         {
         temp = 10 * temp + VALUE(ch);      /* add digit to number           */
         Getchar();                         /* get next character            */
         }                                  /* end while                     */
      if (ch == '.')
         {
         Getchar();
         temp2 = 1.0;
         while (isdigit(ch))
            {
            temp2 /= 10.0;
            temp += temp2 * VALUE(ch);
            Getchar();
            }
         }
      push(temp);                           /* push final number onto stack  */
      BACKSPACE;                            /* backspace to last digit       */
      }

   else if ((ch >= 'A') && (ch <= 'Z'))     /* if A to Z..                   */
      push(ch - 'A');                       /* put 0 to 25 on stack          */

   else if ((ch >= 'a') && (ch <= 'z'))     /* if a to z..                   */
      push(ch - 'a' + offset);              /* put 0 to 25 + offset on stack */

   else                                     /* if not alphanumeric..         */

      switch (ch)                           /* big switch on current char    */
         {

         case '$' :                         /*  $   macro defn / end of prog */
            break;                          /*         no action             */

         case '_' :                         /*  _   change sign              */
            push(-pop());
            break;

         case '+' :                         /*  +   add                      */
            push(pop() + pop());
            break;

         case  '-' :                        /*  -   subtract                 */
            temp = pop();
            push(pop() - temp);
            break;

         case '*' :                         /*  *   multiply                 */
            push(pop() * pop());
            break;

         case '/' :                         /*  /   divide with zero check   */
            temp = pop();
            if (temp != 0)                  /*         check for div by zero */
               push(pop() / temp);          /*         push if not div by 0  */
            else
               error(4);                    /*         error if div by zero  */
            break;

         case '\\' :                        /*  \   remainder w/ zero check  */
            temp = pop();
            if (temp != 0)                  /*         check for rem by zero */
               push((long)pop() %           /*         push if not rem by 0  */
                    (long)temp);
            else
               error(5);                    /*         error if rem by zero  */
            break;

         case '?' :                         /*  ?   read from keyboard       */
            Getchar();
            if (ch == '\'')                 /*  ?'   read character          */
               {
               fgets(instr, 2, stdin);      /*         read as a string      */
               chomp(instr);                /*         remove \n             */
               sscanf(instr, "%c", &ch);    /*         read character        */
               push((double)ch);
               }
            else                            /*  ?    read number             */
               {
               fgets(instr, 25, stdin);     /*         read as a string      */
               chomp(instr);                /*         remove \n             */
               sscanf(instr, "%lf", &temp); /*         read number           */
               push(temp);
               BACKSPACE;
               }
            break;

         case '!' :                         /*  !   display on screen        */
            Getchar();
            if (ch == '\'')                 /*  !'   display character       */
               printf("%c", round(pop()));
            else                            /*  !    display number          */
               {
               sprintf(format_str, "%%%d.", /*         create format string  */
                  display_width);
               sprintf(temp_str, "%d",
                  display_digits);
               strcat(format_str,temp_str);
               if (display_mode == 0)       /*         if fixed mode         */
                  strcat(format_str,"f");
               else if (display_mode == 1)  /*         if sci mode           */
                  strcat(format_str,"E");
               else                         /*         if general mode       */
                  strcat(format_str,"G");
               printf(format_str, pop());   /*         print number          */
               BACKSPACE;
               }
            break;

         case '"' :                         /*  "   display string on screen */
            do {
               Getchar();
               if (ch == '!')               /*         check for newline     */
                  printf("\n");             /*         print newline         */
               else if (ch != '"')          /*         check for end of str  */
                  printf ("%c", ch);        /*         print if not "        */
               } while (ch != '"');
            break;

         case ':' :                         /*  :   assignment               */
            temp = pop();
            data[round(temp)] = pop();
            break;

         case '.' :                         /*  .   dereference              */
            push(data[round(pop())]);
            break;

         case '<' :                         /*  <   less than                */
            temp = pop();
            push ((pop() < temp) ? 1 : 0);
            break;

         case '=' :                         /*  =   equal to                 */
            push ((pop()==pop()) ? 1 : 0);
            break;

         case '>' :                         /*  >   greater than             */
            temp = pop();
            push ((pop() > temp) ? 1 : 0);
            break;

         case '[' :                         /*  [   conditional statement    */
            if (pop() <= 0)                 /*         true if > 0           */
               skip2('[','|',']');
            break;

         case ']' :                         /*  ]   end of conditional       */
            break;                          /*         no action             */

         case '|':                          /*  |   else                     */
            skip('[',']');
            break;

         case '(' :                         /*  (   begin loop               */
            pushenv(loop);
            break;

         case ')' :                         /*  )   end loop                 */
            charpos=envstack[esp].charpos;
            break;

         case '^' :                         /*  ^   exit loop                */
            if (pop() <= 0)
               {
               popenv();
               skip('(',')');
               }
            break;

         case '#':                          /*  #   macro call               */
            Getchar();                      /*         get macro letter      */
            UPPERCASE;                      /*         convert to uppercase  */
            if ((ch>='A') && (ch<='Z'))     /*         if A to Z..           */
               {
               if (macdefs[ch-'A'] > 0)     /*         if macro defined..    */
                  {
                  pushenv(macro);           /*         push env stack frame  */
                  charpos=macdefs[ch-'A'];  /*         instruct ptr to macro */
                  if (nextfree + LOCSIZE    /*         if variables avail..  */
                          <= MAXADDR)
                     {
                     offset = nextfree;     /*         increment offset      */
                     nextfree += LOCSIZE;   /*         increment nextfree    */
                     }
                  else                      /*         out of variable space */
                     error(10);             /*         print error message   */
                  }
               else                         /*         macro not defined     */
                  error(6);                 /*         print error message   */
               }
            else                            /*         invalid char after #  */
               error(7);                    /*         print error message   */
            break;

         case '@':                          /*  @   return from macro        */
            do {                            /*         loop to discard loops */
               popenv();                    /*         pop env stack frame   */
               } while (envtag != macro);   /*         repeat til macro found*/
            skip('#',';');                  /*         skip to ;             */
            nextfree -= LOCSIZE;            /*         decrement nextfree    */
            break;

         case '%':                          /*  %   replace formal by actual */
            pushenv(parameter);             /*         push stack frame      */
            parbal = 1;                     /*         1 stack already pushed*/
            tsp = esp;                      /*         temp env stack pointer*/
            do {                            /*         loop thru env stack   */
               tsp--;                       /*         decrement stack ptr   */
               switch (envstack[tsp].tag)   /*         check tag type        */
                  {
                  case macro :              /*         if macro (#)..        */
                     parbal--;              /*         decrement counter     */
                     break;
                  case parameter :          /*         if parameter (%)..    */
                     parbal++;              /*         nest another level    */
                     break;
                  case loop :               /*         if loop [ ( ]..       */
                     break;                 /*         keep searching        */
                  }
               } while (parbal != 0);       /*        til calling macro found*/
            charpos=envstack[tsp].charpos;  /*        update instruct ptr    */
            offset = envstack[tsp].offset;  /*        pt to new variable set */
            parnum = pop();                 /*        get parameter number   */
            do {                            /*        look for actual param  */
               Getchar();                   /*        read program character */
               if (ch == '"')               /*         param contains string */
                  skipstring();             /*         skip string           */
               else if (ch == '#')          /*         param has macro call  */
                  skip('#',';');            /*         skip to end of macro  */
               else if (ch == ',')          /*         count commas          */
                  parnum--;                 /*         decrement comma ctr   */
               else if (ch == ';')          /*         param doesn't exist   */
                  {
                  parnum = 0;               /*         stop loop             */
                  popenv();                 /*         null parameter        */
                  }
               } while (parnum != 0);       /*         loop until param found*/
            break;

         case ',' :                         /*  ,   end of actual parameter  */
         case ';' :                         /*  ;   end of macro call        */
            popenv();
            break;

         case '\''  :                       /*  '   stack next character     */
            Getchar();
            push(ch);
            break;

         case '{' :                         /*  {   trace on                 */
            tracing = 1;
            break;

         case '}' :                         /*  }   trace off                */
            tracing = 0;
            break;

         case '&':                          /*  &   & function               */
            p = amp_str;
            Getchar();                      /*         read 1st char after & */
            while (ch!='&' && ch!='$')      /*         loop until end & or $ */
               {
               *p++ = tolower(ch);          /*         copy char to amp_str  */
               Getchar();                   /*         read next char        */
               }
            *p = '\0';                      /*         add end-of-string     */
            process_amp(amp_str);           /*         call & subroutine     */
            break;

         default :                          /*      unused character         */
            error(11);                      /*         print error message   */
            break;
         }                                  /* end switch                    */

   } while (!((ch == '$') || disaster));    /* loop until end of program ($) */
}                                           /* end interpret                 */





/*****************************************************************************/
/*                                                                           */
/*  process_amp()                                                            */
/*                                                                           */
/*  Process & functions.                                                     */
/*                                                                           */
/*****************************************************************************/

void process_amp(char *str)
{
long i, j;                                  /* loop counters                 */
double  hr, min, sec;
struct tm *systime;
time_t  t;
char instr[26];                             /* input string                  */


if (!strcmp(str,"2x"))                      /* &2x                           */
   push(pow(2.0,pop()));

else if (!strcmp(str,"4th"))                /* &4th                          */
   {
   temp = pop();
   push(temp*temp*temp*temp);
   }

else if (!strcmp(str,"4thrt"))              /* &4thrt                        */
   {
   temp = pop();
   if (temp >= 0.0)
      push(sqrt(sqrt(temp)));
   else
      error(31);
   }

else if (!strcmp(str,"10x"))                /* &10x                          */
   push(pow(10.0,pop()));

else if (!strcmp(str,"abs"))                /* &abs                          */
   push(fabs(pop()));

else if (!strcmp(str,"acos"))               /* &acos                         */
   {
   temp = pop();
   if (fabs(temp) <= 1.0)
      push(acos(temp)/angle_factor);
   else
      error(12);
   }

else if (!strcmp(str,"acosh"))              /* &acosh                        */
   {
   temp = pop();
   if (temp >= 1.0)
      push(log(temp+sqrt(temp*temp-1.0)));
   else
      error(13);
   }

else if (!strcmp(str,"and"))                /* &and                          */
   {
   itemp = round(pop());
   itemp2 = round(pop());
   push((double)(itemp & itemp2));
   }

else if (!strcmp(str,"asin"))               /* &asin                         */
   {
   temp = pop();
   if (fabs(temp) <= 1.0)
      push(asin(temp)/angle_factor);
   else
      error(14);
   }

else if (!strcmp(str,"asinh"))              /* &asinh                        */
   {
   temp = pop();
   push(log(temp+sqrt(temp*temp+1.0)));
   }

else if (!strcmp(str,"atan"))               /* &atan                         */
   push(atan(pop())/angle_factor);

else if (!strcmp(str,"atan2"))              /* &atan2                        */
   {
   temp = pop();
   push(atan2(pop(),temp)/angle_factor);
   }

else if (!strcmp(str,"atanh"))              /* &atanh                        */
   {
   temp = pop();
   if (fabs(temp) < 1.0)
      push(0.5*log((1.0+temp)/(1.0-temp)));
   else
      error(15);
   }

else if (!strcmp(str,"au"))                 /* &au                           */
   push(AU);

else if (!strcmp(str,"beep"))               /* &beep                         */
   printf("\a");

else if (!strcmp(str,"c"))                  /* &c                            */
   push(SPEED_OF_LIGHT);

else if (!strcmp(str,"clrstk"))             /* &clrstk                       */
   sp = -1;

else if (!strcmp(str,"cm>in"))              /* &cm>in                        */
   push(pop()/IN_CM);

else if (!strcmp(str,"cnr"))                /* &cnr                          */
   {
   itemp = round(pop());
   itemp2 = round(pop());
   if ((itemp>=0) && (itemp2>=0) &&
       (itemp<=itemp2))
      {
      temp = 1.0;
      for (i=itemp2, j=(itemp2-itemp);
           j>=1; i--, j--)
         temp *= (double)i/(double)j;
      push(temp);
      }
   else
      error(23);
   }

else if (!strcmp(str,"cont"))               /* &cont                         */
   charpos=envstack[esp].charpos;

else if (!strcmp(str,"cos"))                /* &cos                          */
   push(cos(pop()*angle_factor));

else if (!strcmp(str,"cosh"))               /* &cosh                         */
   push(cosh(pop()));

else if (!strcmp(str,"cube"))               /* &cube                         */
   {
   temp = pop();
   push(temp*temp*temp);
   }

else if (!strcmp(str,"cubert"))             /* &cubert                       */
   {
   temp = pop();
   if (temp > 0.0)
      push(pow(temp, 1.0/3.0));
   else if (temp == 0.0)
      push(0.0);
   else
      error(30);
   }

else if (!strcmp(str,"c>f"))                /* &c>f                          */
   push(pop()*9.0/5.0+32.0);

else if (!strcmp(str,"deg"))                /* &deg                          */
   angle_factor = PI/180.0;

else if (!strcmp(str,"dom"))                /* &dom                          */
   {
   t = time(NULL);
   systime = localtime(&t);
   push((double)systime->tm_mday);
   }

else if (!strcmp(str,"dow"))                /* &dow                          */
   {
   t = time(NULL);
   systime = localtime(&t);
   push((double)(systime->tm_wday+1));
   }

else if (!strcmp(str,"doy"))                /* &doy                          */
   {
   t = time(NULL);
   systime = localtime(&t);
   push((double)(systime->tm_yday+1));
   }

else if (!strcmp(str,"drop"))               /* &drop                         */
   pop();

else if (!strcmp(str,"dup"))                /* &dup                          */
   {
   temp = pop();
   push(temp);
   push(temp);
   }

else if (!strcmp(str,"d>r"))                /* &d>r                          */
   push(pop()*PI/180.0);

else if (!strcmp(str,"e"))                  /* &e                            */
   push(ELEMENTARY_CHG);

else if (!strcmp(str,"eex"))                /* &eex                          */
   {
   temp = pop();
   push(pop()*pow(10.0,temp));
   }

else if (!strcmp(str,"eps0"))               /* &eps0                         */
   push(PERMITTIVITY);

else if (!strcmp(str,"exit"))               /* &exit                         */
   done = 1;

else if (!strcmp(str,"exp"))                /* &exp                          */
   push(exp(pop()));

else if (!strcmp(str,"fact"))               /* &fact                         */
   {
   ntemp = round(pop());
   if (ntemp >= 0)
      {
      temp = 1.0;
      for (i=2; i<=ntemp; i++)
         temp *= (double)i;
      push(temp);
      }
   else
      error(21);
   }

else if (!strcmp(str,"fclose"))             /* &fclose                       */
   fclose(fp[round(pop())]);

else if (!strcmp(str,"feof"))               /* &feof                         */
   push(feof(fp[round(pop())]) ? 1 : 0);

else if (!strcmp(str,"fix"))                /* &fix                          */
   {
   display_mode = 0;
   display_digits = round(pop());
   }

else if (!strcmp(str,"fopen"))              /* &fopen                        */
   {
   itemp = round(pop());
   itemp2 = round(pop());
   sprintf(filenum_str,"%03d",itemp2);
   strcpy(filename_str,"mouse.");
   strcat(filename_str, filenum_str);
   switch (itemp)
      {
      case 0:  strcpy(filemode_str,"r");
               break;
      case 1:  strcpy(filemode_str,"w");
               break;
      case 2:  strcpy(filemode_str,"rb");
               break;
      case 3:  strcpy(filemode_str,"wb");
               break;
      }
   if ((fp[itemp2] = fopen(filename_str,
        filemode_str))==NULL)
      {
      error(28);
      return;
      }
   }

else if (!strcmp(str,"frac"))               /* &frac                         */
   push(Frac(pop()));

else if (!strcmp(str,"frewind"))            /* &frewind                      */
   rewind(fp[round(pop())]);

else if (!strcmp(str,"f>c"))                /* &f>c                          */
   push((pop()-32.0)*5.0/9.0);

else if (!strcmp(str,"f?"))                 /* &f?                           */
   {
   fscanf(fp[round(pop())],"%lf", &temp);
   push(temp);
   }

else if (!strcmp(str,"f?'"))                /* &f?'                          */
   {
   fscanf(fp[round(pop())],"%c", &ch);
   push((double)ch);
   }

else if (!strcmp(str,"f!"))                 /* &f!                           */
   {
   sprintf(format_str, "%%%d.",             /*         create format string  */
      display_width);
   sprintf(temp_str, "%d",
      display_digits);
   strcat(format_str,temp_str);
   if (display_mode == 0)                   /*         if fixed mode         */
      strcat(format_str,"f");
   else if (display_mode == 1)              /*         if sci mode           */
      strcat(format_str,"E");
   else                                     /*         if general mode       */
      strcat(format_str,"G");
   itemp = round(pop());
   fprintf(fp[itemp],format_str,pop());     /*         print number          */
   }

else if (!strcmp(str,"f!'"))                /* &f!'                          */
   {
   itemp = round(pop());
   fprintf(fp[itemp],"%c", round(pop()));
   }

else if (!strcmp(str,"f\""))                /* &f"                           */
   {
   itemp = round(pop());
   do {
      Getchar();
      if (ch == '!')                        /*         check for newline     */
         fprintf(fp[itemp],"\n");           /*         print newline         */
      else if (ch != '"')                   /*         check for end of str  */
         fprintf (fp[itemp],"%c", ch);      /*         print if not "        */
      } while (ch != '"');
   }

else if (!strcmp(str,"g"))                  /* &g                            */
   push(GRAV_CONST);

else if (!strcmp(str,"g0"))                 /* &g0                           */
   push(GRAV_ACCEL);

else if (!strcmp(str,"gal>l"))              /* &gal>l                        */
   push(pop()*GAL_L);

else if (!strcmp(str,"ge"))                 /* &ge                           */
   {
   temp = pop();
   push ((pop() >= temp) ? 1 : 0);
   }

else if (!strcmp(str,"gen"))                /* &gen                          */
   {
   display_mode = 2;
   display_digits = round(pop());
   }

else if (!strcmp(str,"gmearth"))            /* &gmearth                      */
   push(GM_EARTH);

else if (!strcmp(str,"gmsun"))              /* &gmsun                        */
   push(GM_SUN);

else if (!strcmp(str,"grad"))               /* &grad                         */
   angle_factor = PI/200.0;

else if (!strcmp(str,"h"))                  /* &h                            */
   push(PLANCK);

else if (!strcmp(str,"halfpi"))             /* &halfpi                          */
   push(0.5*PI);

else if (!strcmp(str,"hbar"))               /* &hbar                         */
   push(H_BAR);

else if (!strcmp(str,"hms>h"))              /* &hms>h                        */
   {
   temp = pop();
   hr = Int(temp);
   min = Int(100.0*Frac(temp));
   sec = 100.0*Frac(100.0*temp);
   push(hr + min/60.0 + sec/3600.0);
   }

else if (!strcmp(str,"hour"))               /* &hour                         */
   {
   t = time(NULL);
   systime = localtime(&t);
   push((double)systime->tm_hour);
   }

else if (!strcmp(str,"h>hms"))              /* &h>hms                        */
   {
   temp = pop();
   hr = Int(temp);
   min = Int(60.0*Frac(temp));
   sec = 60.0*Frac(60.0*temp);
   push(hr + min/100.0 + sec/10000.0);
   }

else if (!strcmp(str,"int"))                /* &int                          */
   push(Int(pop()));

else if (!strcmp(str,"in>cm"))              /* &in>cm                        */
   push(pop()*IN_CM);

else if (!strcmp(str,"kb"))                 /* &kb                           */
   push(BOLTZMANN);

else if (!strcmp(str,"kg>lb"))              /* &kg>lb                        */
   push(pop()/LB_KG);

else if (!strcmp(str,"lb>kg"))              /* &lb>kg                        */
   push(pop()*LB_KG);

else if (!strcmp(str,"le"))                 /* &le                           */
   {
   temp = pop();
   push ((pop() <= temp) ? 1 : 0);
   }

else if (!strcmp(str,"ln"))                 /* &ln                           */
   {
   temp = pop();
   if (temp > 0.0)
      push(log(temp));
   else
      error(16);
   }

else if (!strcmp(str,"log"))                /* &log                          */
   {
   temp = pop();
   if (temp > 0.0)
      push(log(temp));
   else
      error(16);
   }

else if (!strcmp(str,"log2"))               /* &log2                         */
   {
   temp = pop();
   if (temp > 0.0)
      push(log(temp)/log(2.0));
   else
      error(17);
   }

else if (!strcmp(str,"log10"))              /* &log10                        */
   {
   temp = pop();
   if (temp > 0.0)
      push(log10(temp));
   else
      error(18);
   }

else if (!strcmp(str,"l>gal"))              /* &l>gal                        */
   push(pop()/GAL_L);

else if (!strcmp(str,"me"))                 /* &me                           */
   push(MASS_ELECTRON);

else if (!strcmp(str,"min"))                /* &min                          */
   {
   t = time(NULL);
   systime = localtime(&t);
   push((double)systime->tm_min);
   }

else if (!strcmp(str,"mn"))                 /* &mn                           */
   push(MASS_NEUTRON);

else if (!strcmp(str,"month"))              /* &month                        */
   {
   t = time(NULL);
   systime = localtime(&t);
   push((double)(systime->tm_mon+1));
   }

else if (!strcmp(str,"mp"))                 /* &mp                           */
   push(MASS_PROTON);

else if (!strcmp(str,"mu0"))                /* &mu0                          */
   push(PERMEABILITY);

else if (!strcmp(str,"na"))                 /* &na                           */
   push(AVAGADRO);

else if (!strcmp(str,"ne"))                 /* &ne                           */
   {
   temp = pop();
   push ((pop() != temp) ? 1 : 0);
   }

else if (!strcmp(str,"nip"))                /* &nip                          */
   {
   temp = pop();
   pop();
   push(temp);
   }

else if (!strcmp(str,"not"))                /* &not                          */
   {
   itemp = round(pop());
   push((double)(~itemp));
   }

else if (!strcmp(str,"or"))                 /* &or                           */
   {
   itemp = round(pop());
   itemp2 = round(pop());
   push((double)(itemp | itemp2));
   }

else if (!strcmp(str,"over"))               /* &over                         */
   {
   temp = pop();
   temp2 = pop();
   push(temp2);
   push(temp);
   push(temp2);
   }

else if (!strcmp(str,"pi"))                 /* &pi                           */
   push(PI);

else if (!strcmp(str,"pnr"))                /* &pnr                          */
   {
   itemp = round(pop());
   itemp2 = round(pop());
   if ((itemp>=0) && (itemp2>=0) &&
       (itemp<=itemp2))
      {
      temp = 1.0;
      for (i=itemp2;
           i>=(itemp2-itemp+1);
           i--)
         temp *= (double)i;
      push(temp);
      }
   else
      error(24);
   }

else if (!strcmp(str,"pow"))                /* &pow                          */
   {
   temp = pop();
   temp2 = pop();
   error_flag = ((temp2==0.0) &&
      (temp<=0.0)) ||
      ((temp2<0) &&
      (temp!=round(temp)));
   if (!error_flag)
      push(pow(temp2, temp));
   else
      error(26);
   }

else if (!strcmp(str,"p>r"))                /* &p>r                          */
   {
   temp = pop();
   temp2 = pop();
   push(temp*cos(temp2*angle_factor));
   push(temp*sin(temp2*angle_factor));
   }

else if (!strcmp(str,"quit"))               /* &quit                         */
   done = 1;

else if (!strcmp(str,"rad"))                /* &rad                          */
   angle_factor = 1.0;

else if (!strcmp(str,"rand"))               /* &rand                         */
   push((double)rand()/(double)RAND_MAX);

else if (!strcmp(str,"rcl"))                /* &rcl                          */
   {
   itemp = round(pop());
   if ((itemp>=0) && (itemp<ARRAYSIZE))
      push(array[itemp]);
   else
      error(25);
   }

else if (!strcmp(str,"rearth"))             /* &rearth                       */
   push(R_EARTH);

else if (!strcmp(str,"recip"))              /* &recip                        */
   {
   temp = pop();
   if (temp != 0.0)
      push(1.0/temp);
   else
      error(19);
   }

else if (!strcmp(str,"rev"))                /* &rev                          */
   angle_factor = PI+PI;

else if (!strcmp(str,"root"))               /* &root                         */
   {
   temp = pop();
   temp2 = pop();
   error_flag = (temp==0.0) ||
      ((temp2==0.0) && (temp<=0.0)) ||
      ((temp2<0) &&
      ((1.0/temp)!=round(1.0/temp)));
   if (!error_flag)
      push(pow(temp2, 1.0/temp));
   else
      error(27);
   }

else if (!strcmp(str,"rot"))                /* &rot                          */
   {
   temp = pop();
   temp2 = pop();
   temp3 = pop();
   push(temp2);
   push(temp);
   push(temp3);
   }

else if (!strcmp(str,"round"))              /* &round                        */
   push((double)round(pop()));

else if (!strcmp(str,"r>d"))                /* &r>d                          */
   push(pop()*180.0/PI);

else if (!strcmp(str,"r>p"))                /* &r>p                          */
   {
   temp = pop();
   temp2 = pop();
   push(atan2(temp2,temp)/angle_factor);
   push(sqrt(temp*temp + temp2*temp2));
   }

else if (!strcmp(str,"sci"))                /* &sci                          */
   {
   display_mode = 1;
   display_digits = round(pop());
   }

else if (!strcmp(str,"sec"))                /* &sec                          */
   {
   t = time(NULL);
   systime = localtime(&t);
   push((double)systime->tm_sec);
   }

else if (!strcmp(str,"seed"))               /* &seed                         */
   srand(round(pop()));

else if (!strcmp(str,"shl"))                /* &shl                          */
   {
   itemp = round(pop());
   itemp2 = round(pop());
   push((double)(itemp2 << itemp));
   }

else if (!strcmp(str,"shr"))                /* &shr                          */
   {
   itemp = round(pop());
   itemp2 = round(pop());
   push((double)(itemp2 >> itemp));
   }

else if (!strcmp(str,"sin"))                /* &sin                          */
   push(sin(pop()*angle_factor));

else if (!strcmp(str,"sinh"))               /* &sinh                         */
   push(sinh(pop()));

else if (!strcmp(str,"sqr"))                /* &sqr                          */
   {
   temp = pop();
   push(temp*temp);
   }

else if (!strcmp(str,"sqrt"))               /* &sqrt                         */
   {
   temp = pop();
   if (temp >= 0.0)
      push(sqrt(temp));
   else
      error(20);
   }

else if (!strcmp(str,"sto"))                /* &sto                          */
   {
   itemp = round(pop());
   if ((itemp>=0) && (itemp<ARRAYSIZE))
      array[itemp] = pop();
   else
      error(25);
   }

else if (!strcmp(str,"swap"))               /* &swap                         */
   {
   temp = pop();
   temp2 = pop();
   push(temp);
   push(temp2);
   }

else if (!strcmp(str,"tan"))                /* &tan                          */
   push(tan(pop()*angle_factor));

else if (!strcmp(str,"tanh"))               /* &tanh                         */
   push(tanh(pop()));

else if (!strcmp(str,"time"))               /* &time                         */
   push((double)time(NULL));

else if (!strcmp(str,"tuck"))               /* &tuck                         */
   {
   temp = pop();
   temp2 = pop();
   push(temp);
   push(temp2);
   push(temp);
   }

else if (!strcmp(str,"twopi"))              /* &twopi                           */
   push(PI+PI);

else if (!strcmp(str,"ver"))                /* &ver                          */
   push(VERSION);

else if (!strcmp(str,"width"))              /* &width                        */
   display_width = round(pop());

else if (!strcmp(str,"wsize"))              /* &wsize                        */
   {
   if ((wordsize >= 1) && (wordsize <= 32))
      wordsize = round(pop());
   else
      error(22);
   }

else if (!strcmp(str,"xor"))                /* &xor                          */
   {
   itemp = round(pop());
   itemp2 = round(pop());
   push((double)(itemp ^ itemp2));
   }

else if (!strcmp(str,"y2x"))                /* &y2x                          */
   {
   temp = pop();
   push(pop()*pow(2.0,temp));
   }

else if (!strcmp(str,"year"))               /* &year                         */
   {
   t = time(NULL);
   systime = localtime(&t);
   push((double)(systime->tm_year+1900));
   }

else if (!strcmp(str,"?hex"))               /* &?hex                         */
   {
   fgets(instr, 25, stdin);                 /*         read as a string      */
   chomp(instr);                            /*         remove \n             */
   sscanf(instr, "%lx", &itemp);            /*         read number           */
   push((double)itemp);
   }

else if (!strcmp(str,"?oct"))               /* &?oct                         */
   {
   fgets(instr, 25, stdin);                 /*         read as a string      */
   chomp(instr);                            /*         remove \n             */
   sscanf(instr, "%lo", &itemp);            /*         read number           */
   push((double)itemp);
   }

else if (!strcmp(str,"!dec"))               /* &!dec                         */
   {
   sprintf(format_str, "%%%d.",
      display_width);
   sprintf(temp_str,"%dd",display_width);
   strcat(format_str,temp_str);
   printf(format_str,
         (long)pop());
   }

else if (!strcmp(str,"!hex"))               /* &!hex                         */
   {
   octhex_digits = ((wordsize-1)/4)+1;
   if (wordsize == 32)
      octhex_mask = 0xFFFFFFFF;
   else
      octhex_mask = (1L << wordsize) - 1;
   sprintf(format_str, "%%%d.",
      octhex_digits);
   sprintf(temp_str,"%dX",octhex_digits);
   strcat(format_str,temp_str);
   printf(format_str,
         (long)pop() & octhex_mask);
   }

else if (!strcmp(str,"!oct"))               /* &!oct                         */
   {
   octhex_digits = ((wordsize-1)/3)+1;
   if (wordsize == 32)
      octhex_mask = 0xFFFFFFFF;
   else
      octhex_mask = (1L << wordsize) - 1;
   sprintf(format_str, "%%%d.",
      octhex_digits);
   sprintf(temp_str,"%do",octhex_digits);
   strcat(format_str,temp_str);
   printf(format_str,
         (long)pop() & octhex_mask);
   }

else if (!strcmp(str,"!stk"))               /* &!stk                         */
   {
   sprintf(format_str, "%%%d.",             /*         create format string  */
      display_width);
   sprintf(temp_str, "%d",
      display_digits);
   strcat(format_str,temp_str);
   if (display_mode == 0)                   /*         if fixed mode         */
      strcat(format_str,"f\n");
   else if (display_mode == 1)              /*         if sci mode           */
      strcat(format_str,"E\n");
   else                                     /*         if general mode       */
      strcat(format_str,"G\n");
   if (sp < 0)
      printf("Stack empty");
   else
      for (i=0; i<=sp; i++)
         printf(format_str, stack[i]);
   }

else
   error(29);
}





/*****************************************************************************/
/*  chomp()                                                                  */
/*                                                                           */
/*  Remove final \n from end of string.                                      */
/*****************************************************************************/

void chomp (char *str)
{
int  len;                                   /* length of str (incl \n)       */

len = strlen (str);                         /* get length of str incl \n     */
if (str[len-1] == '\n')                     /* if final char is \n ..        */
   str[len-1] = '\0';                       /* ..then remove it              */
}





/*****************************************************************************/
/*                                                                           */
/*  Int()                                                                    */
/*                                                                           */
/*****************************************************************************/

double Int (double f)
{
return ((long)(f));
}





/*****************************************************************************/
/*                                                                           */
/*  Frac()                                                                   */
/*                                                                           */
/*****************************************************************************/

double Frac (double f)
{
return (f - (long)(f));
}





/*****************************************************************************/
/*                                                                           */
/*  round()                                                                  */
/*                                                                           */
/*  Round a double to the nearest integer.                                   */
/*                                                                           */
/*****************************************************************************/

long round(double x)
{
double result;

if (x < 0.0)
   result = (long)(x-0.5);
else
   result = (long)(x+0.5);
return result;
}