please dont rip this site

Mouse 2002 Programming Language Interpreter in C

Mouse-2002 is David Simpson's own extension of the Mouse-83 programming language originally described in the book Mouse: A Language for Microcomputers by Peter Grogono in 1983 [2]. It includes a number of extensions to Mouse-83:

/*                               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;
}




See also:


file: /Techref/language/mouse/interpreter-c-2002.htm, 79KB, , updated: 2016/1/5 15:54, local time: 2017/12/16 03:18,
TOP NEW HELP FIND: 
54.163.61.66:LOG IN

 ©2017 These pages are served without commercial sponsorship. (No popup ads, etc...).Bandwidth abuse increases hosting cost forcing sponsorship or shutdown. This server aggressively defends against automated copying for any reason including offline viewing, duplication, etc... Please respect this requirement and DO NOT RIP THIS SITE. Questions?
Please DO link to this page! Digg it! / MAKE! / 

<A HREF="http://www.piclist.com/techref/language/mouse/interpreter-c-2002.htm"> Mouse 2002 Programming Language Interpreter in C</A>

After you find an appropriate page, you are invited to your to this massmind site! (posts will be visible only to you before review) Just type in the box and press the Post button. (HTML welcomed, but not the <A tag: Instead, use the link box to link to another page. A tutorial is available Members can login to post directly, become page editors, and be credited for their posts.


Link? Put it here: 
if you want a response, please enter your email address: 
Attn spammers: All posts are reviewed before being made visible to anyone other than the poster.
Did you find what you needed?

  PICList 2017 contributors:
o List host: MIT, Site host massmind.org, Top posters @20171216 RussellMc, Van Horn, David, Sean Breheny, James Cameron, alan.b.pearce, IVP, Neil, Bob Blick, David C Brown, John Gardner,
* Page Editors: James Newton, David Cary, and YOU!
* Roman Black of Black Robotics donates from sales of Linistep stepper controller kits.
* Ashley Roll of Digital Nemesis donates from sales of RCL-1 RS232 to TTL converters.
* Monthly Subscribers: Gregg Rew. on-going support is MOST appreciated!
* Contributors: Richard Seriani, Sr.
 

Welcome to www.piclist.com!

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

  .