Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- /*****************************************************************************/
- /* */
- /* 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 */
- int 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("BEEP\n");
- //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")) /* ° */
- 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 ((int)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")) /* ¬ */
- {
- 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. */
- /* */
- /*****************************************************************************/
- int Round(double x) {
- int result;
- if (x < 0.0)
- result = (int)(x-0.5);
- else
- result = (int)(x+0.5);
- return result;
- }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement