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")) /* ° */ 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")) /* ¬ */ { 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; }
file: /Techref/language/mouse/interpreter-c-2002.htm, 79KB, , updated: 2016/1/5 15:54, local time: 2024/11/16 02:37,
3.139.97.97:LOG IN
|
©2024 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? <A HREF="http://linistepper.com/techref/language/mouse/interpreter-c-2002.htm"> Mouse 2002 Programming Language Interpreter in C</A> |
Did you find what you needed? |