home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / astrnomy / ephem421.zip / COMPILER.C < prev    next >
C/C++ Source or Header  |  1990-09-13  |  16KB  |  581 lines
  1. /* module to compile and execute a c-style arithmetic expression.
  2.  * public entry points are compile_expr() and execute_expr().
  3.  *
  4.  * one reason this is so nice and tight is that all opcodes are the same size
  5.  * (an int) and the tokens the parser returns are directly usable as opcodes,
  6.  * for the most part. constants and variables are compiled as an opcode
  7.  * with an offset into the auxiliary opcode tape, opx.
  8.  */
  9.  
  10. #include <math.h>
  11. #ifdef VMS
  12. #include <stdlib.h>
  13. #endif
  14. #include "screen.h"
  15.  
  16. /* parser tokens and opcodes, as necessary */
  17. #define    HALT    0    /* good value for HALT since program is inited to 0 */
  18. /* binary operators (precedences in table, below) */
  19. #define    ADD    1
  20. #define    SUB    2
  21. #define    MULT    3
  22. #define    DIV    4
  23. #define    AND    5
  24. #define    OR    6
  25. #define    GT    7
  26. #define    GE    8
  27. #define    EQ    9
  28. #define    NE    10
  29. #define    LT    11
  30. #define    LE    12
  31. /* unary op, precedence in NEG_PREC #define, below */
  32. #define    NEG    13
  33. /* symantically operands, ie, constants, variables and all functions */
  34. #define    CONST    14    
  35. #define    VAR    15
  36. #define    ABS    16    /* add functions if desired just like this is done */
  37. /* purely tokens - never get compiled as such */
  38. #define    LPAREN    255
  39. #define    RPAREN    254
  40. #define    ERR    (-1)
  41.  
  42. /* precedence of each of the binary operators.
  43.  * in case of a tie, compiler associates left-to-right.
  44.  * N.B. each entry's index must correspond to its #define!
  45.  */
  46. static int precedence[] = {0,5,5,6,6,2,1,4,4,3,3,4,4};
  47. #define    NEG_PREC    7    /* negation is highest */
  48.  
  49. /* execute-time operand stack */
  50. #define    MAX_STACK    16
  51. static double stack[MAX_STACK], *sp;
  52.  
  53. /* space for compiled opcodes - the "program".
  54.  * opcodes go in lower 8 bits.
  55.  * when an opcode has an operand (as CONST and VAR) it is really in opx[] and
  56.  *   the index is in the remaining upper bits.
  57.  */
  58. #define    MAX_PROG 32
  59. static int program[MAX_PROG], *pc;
  60. #define    OP_SHIFT    8
  61. #define    OP_MASK        0xff
  62.  
  63. /* auxiliary operand info.
  64.  * the operands (all but lower 8 bits) of CONST and VAR are really indeces
  65.  * into this array. thus, no point in making this any longer than you have
  66.  * bits more than 8 in your machine's int to index into it, ie, make
  67.  *    MAX_OPX <= 1 << ((sizeof(int)-1)*8)
  68.  * also, the fld's must refer to ones being flog'd, so not point in more
  69.  * of these then that might be used for plotting and srching combined.
  70.  */
  71. #define    MAX_OPX    16
  72. typedef union {
  73.     double opu_f;        /* value when opcode is CONST */
  74.     int opu_fld;        /* rcfpack() of field when opcode is VAR */
  75. } OpX;
  76. static OpX opx[MAX_OPX];
  77. static int opxidx;
  78.  
  79. /* these are global just for easy/rapid access */
  80. static int parens_nest;    /* to check that parens end up nested */
  81. static char *err_msg;    /* caller provides storage; we point at it with this */
  82. static char *cexpr, *lcexpr; /* pointers that move along caller's expression */
  83. static int good_prog;    /* != 0 when program appears to be good */
  84.  
  85. /* compile the given c-style expression.
  86.  * return 0 and set good_prog if ok,
  87.  * else return -1 and a reason message in errbuf.
  88.  */
  89. compile_expr (ex, errbuf)
  90. char *ex;
  91. char *errbuf;
  92. {
  93.     int instr;
  94.  
  95.     /* init the globals.
  96.      * also delete any flogs used in the previous program.
  97.      */
  98.     cexpr = ex;
  99.     err_msg = errbuf;
  100.     pc = program;
  101.     opxidx = 0;
  102.     parens_nest = 0;
  103.     do {
  104.         instr = *pc++;
  105.         if ((instr & OP_MASK) == VAR)
  106.         flog_delete (opx[instr >> OP_SHIFT].opu_fld);
  107.     } while (instr != HALT);
  108.  
  109.     pc = program;
  110.     if (compile(0) == ERR) {
  111.         (void) sprintf (err_msg + strlen(err_msg), " at \"%.10s\"", lcexpr);
  112.         good_prog = 0;
  113.         return (-1);
  114.     }
  115.     *pc++ = HALT;
  116.     good_prog = 1;
  117.     return (0);
  118. }
  119.  
  120. /* execute the expression previously compiled with compile_expr().
  121.  * return 0 with *vp set to the answer if ok, else return -1 with a reason
  122.  * why not message in errbuf.
  123.  */
  124. execute_expr (vp, errbuf)
  125. double *vp;
  126. char *errbuf;
  127. {
  128.     int s;
  129.  
  130.     err_msg = errbuf;
  131.     sp = stack + MAX_STACK;    /* grows towards lower addresses */
  132.     pc = program;
  133.     s = execute(vp);
  134.     if (s < 0)
  135.         good_prog = 0;
  136.     return (s);
  137. }
  138.  
  139. /* this is a way for the outside world to ask whether there is currently a
  140.  * reasonable program compiled and able to execute.
  141.  */
  142. prog_isgood()
  143. {
  144.     return (good_prog);
  145. }
  146.  
  147. /* get and return the opcode corresponding to the next token.
  148.  * leave with lcexpr pointing at the new token, cexpr just after it.
  149.  * also watch for mismatches parens and proper operator/operand alternation.
  150.  */
  151. static
  152. next_token ()
  153. {
  154.     static char toomt[] = "More than %d terms";
  155.     static char badop[] = "Illegal operator";
  156.     int tok = ERR;    /* just something illegal */
  157.     char c;
  158.  
  159.     while ((c = *cexpr) == ' ')
  160.         cexpr++;
  161.     lcexpr = cexpr++;
  162.  
  163.     /* mainly check for a binary operator */
  164.     switch (c) {
  165.     case '\0': --cexpr; tok = HALT; break; /* keep returning HALT */
  166.     case '+': tok = ADD; break; /* compiler knows when it's really unary */
  167.     case '-': tok = SUB; break; /* compiler knows when it's really negate */
  168.     case '*': tok = MULT; break;
  169.     case '/': tok = DIV; break;
  170.     case '(': parens_nest++; tok = LPAREN; break;
  171.     case ')':
  172.         if (--parens_nest < 0) {
  173.             (void) sprintf (err_msg, "Too many right parens");
  174.         return (ERR);
  175.         } else
  176.         tok = RPAREN;
  177.         break;
  178.     case '|':
  179.         if (*cexpr == '|') { cexpr++; tok = OR; }
  180.         else { (void) sprintf (err_msg, badop); return (ERR); }
  181.         break;
  182.     case '&':
  183.         if (*cexpr == '&') { cexpr++; tok = AND; }
  184.         else { (void) sprintf (err_msg, badop); return (ERR); }
  185.         break;
  186.     case '=':
  187.         if (*cexpr == '=') { cexpr++; tok = EQ; }
  188.         else { (void) sprintf (err_msg, badop); return (ERR); }
  189.         break;
  190.     case '!':
  191.         if (*cexpr == '=') { cexpr++; tok = NE; }
  192.         else { (void) sprintf (err_msg, badop); return (ERR); }
  193.         break;
  194.     case '<':
  195.         if (*cexpr == '=') { cexpr++; tok = LE; }
  196.         else tok = LT;
  197.         break;
  198.     case '>':
  199.         if (*cexpr == '=') { cexpr++; tok = GE; }
  200.         else tok = GT;
  201.         break;
  202.     }
  203.  
  204.     if (tok != ERR)
  205.         return (tok);
  206.  
  207.     /* not op so check for a constant, variable or function */
  208.     if (isdigit(c) || c == '.') {
  209.         if (opxidx > MAX_OPX) {
  210.         (void) sprintf (err_msg, toomt, MAX_OPX);
  211.         return (ERR);
  212.         }
  213.         opx[opxidx].opu_f = atof (lcexpr);
  214.         tok = CONST | (opxidx++ << OP_SHIFT);
  215.         skip_double();
  216.     } else if (isalpha(c)) {
  217.         /* check list of functions */
  218.         if (strncmp (lcexpr, "abs", 3) == 0) {
  219.         cexpr += 2;
  220.         tok = ABS;
  221.         } else {
  222.         /* not a function, so assume it's a variable */
  223.         int fld;
  224.         if (opxidx > MAX_OPX) {
  225.             (void) sprintf (err_msg, toomt, MAX_OPX);
  226.             return (ERR);
  227.         }
  228.         fld = parse_fieldname ();
  229.         if (fld < 0) {
  230.             (void) sprintf (err_msg, "Unknown field");
  231.             return (ERR);
  232.         } else {
  233.             if (flog_add (fld) < 0) { /* register with field logger */
  234.             (void) sprintf (err_msg, "Sorry; too many fields");
  235.             return (ERR);
  236.             }
  237.             opx[opxidx].opu_fld = fld;
  238.             tok = VAR | (opxidx++ << OP_SHIFT);
  239.         }
  240.         }
  241.     }
  242.  
  243.     return (tok);
  244. }
  245.  
  246. /* move cexpr on past a double.
  247.  * allow sci notation.
  248.  * no need to worry about a leading '-' or '+' but allow them after an 'e'.
  249.  * TODO: this handles all the desired cases, but also admits a bit too much
  250.  *   such as things like 1eee2...3. geeze; to skip a double right you almost
  251.  *   have to go ahead and crack it!
  252.  */
  253. static
  254. skip_double()
  255. {
  256.     int sawe = 0;    /* so we can allow '-' or '+' right after an 'e' */
  257.  
  258.     while (1) {
  259.         char c = *cexpr;
  260.         if (isdigit(c) || c=='.' || (sawe && (c=='-' || c=='+'))) {
  261.         sawe = 0;
  262.         cexpr++;
  263.         } else if (c == 'e') {
  264.         sawe = 1;
  265.         cexpr++;
  266.         } else
  267.         break;
  268.     }
  269. }
  270.  
  271. /* call this whenever you want to dig out the next (sub)expression.
  272.  * keep compiling instructions as long as the operators are higher precedence
  273.  * than prec, then return that "look-ahead" token that wasn't (higher prec).
  274.  * if error, fill in a message in err_msg[] and return ERR.
  275.  */
  276. static
  277. compile (prec)
  278. int prec;
  279. {
  280.     int expect_binop = 0;    /* set after we have seen any operand.
  281.                  * used by SUB so it can tell if it really 
  282.                  * should be taken to be a NEG instead.
  283.                  */
  284.     int tok = next_token ();
  285.  
  286.         while (1) {
  287.         int p;
  288.         if (tok == ERR)
  289.         return (ERR);
  290.         if (pc - program >= MAX_PROG) {
  291.         (void) sprintf (err_msg, "Program is too long");
  292.         return (ERR);
  293.         }
  294.  
  295.         /* check for special things like functions, constants and parens */
  296.             switch (tok & OP_MASK) {
  297.             case HALT: return (tok);
  298.         case ADD:
  299.         if (expect_binop)
  300.             break;    /* procede with binary addition */
  301.         /* just skip a unary positive(?) */
  302.         tok = next_token();
  303.         continue;
  304.         case SUB:
  305.         if (expect_binop)
  306.             break;    /* procede with binary subtract */
  307.         tok = compile (NEG_PREC);
  308.         *pc++ = NEG;
  309.         expect_binop = 1;
  310.         continue;
  311.             case ABS: /* other funcs would be handled the same too ... */
  312.         /* eat up the function parenthesized argument */
  313.         if (next_token() != LPAREN || compile (0) != RPAREN) {
  314.             (void) sprintf (err_msg, "Function arglist error");
  315.             return (ERR);
  316.         }
  317.         /* then handled same as ... */
  318.             case CONST: /* handled same as... */
  319.         case VAR:
  320.         *pc++ = tok;
  321.         tok = next_token();
  322.         expect_binop = 1;
  323.         continue;
  324.             case LPAREN:
  325.         if (compile (0) != RPAREN) {
  326.             (void) sprintf (err_msg, "Unmatched left paren");
  327.             return (ERR);
  328.         }
  329.         tok = next_token();
  330.         expect_binop = 1;
  331.         continue;
  332.             case RPAREN:
  333.         return (RPAREN);
  334.             }
  335.  
  336.         /* everything else is a binary operator */
  337.         p = precedence[tok];
  338.             if (p > prec) {
  339.                 int newtok = compile (p);
  340.         if (newtok == ERR)
  341.             return (ERR);
  342.                 *pc++ = tok;
  343.         expect_binop = 1;
  344.                 tok = newtok;
  345.             } else
  346.                 return (tok);
  347.         }
  348. }
  349.  
  350. /* "run" the program[] compiled with compile().
  351.  * if ok, return 0 and the final result,
  352.  * else return -1 with a reason why not message in err_msg.
  353.  */
  354. static
  355. execute(result)
  356. double *result;
  357. {
  358.     int instr; 
  359.  
  360.     do {
  361.         instr = *pc++;
  362.         switch (instr & OP_MASK) {
  363.         /* put these in numberic order so hopefully even the dumbest
  364.          * compiler will choose to use a jump table, not a cascade of ifs.
  365.          */
  366.         case HALT: break;    /* outer loop will stop us */
  367.         case ADD:  sp[1] = sp[1] +  sp[0]; sp++; break;
  368.         case SUB:  sp[1] = sp[1] -  sp[0]; sp++; break;
  369.         case MULT: sp[1] = sp[1] *  sp[0]; sp++; break;
  370.         case DIV:  sp[1] = sp[1] /  sp[0]; sp++; break;
  371.         case AND:  sp[1] = sp[1] && sp[0] ? 1 : 0; sp++; break;
  372.         case OR:   sp[1] = sp[1] || sp[0] ? 1 : 0; sp++; break;
  373.         case GT:   sp[1] = sp[1] >  sp[0] ? 1 : 0; sp++; break;
  374.         case GE:   sp[1] = sp[1] >= sp[0] ? 1 : 0; sp++; break;
  375.         case EQ:   sp[1] = sp[1] == sp[0] ? 1 : 0; sp++; break;
  376.         case NE:   sp[1] = sp[1] != sp[0] ? 1 : 0; sp++; break;
  377.         case LT:   sp[1] = sp[1] <  sp[0] ? 1 : 0; sp++; break;
  378.         case LE:   sp[1] = sp[1] <= sp[0] ? 1 : 0; sp++; break;
  379.         case NEG:  *sp = -*sp; break;
  380.         case CONST: *--sp = opx[instr >> OP_SHIFT].opu_f; break;
  381.         case VAR:
  382.         if (flog_get(opx[instr>>OP_SHIFT].opu_fld, --sp, (char *)0)<0) {
  383.             (void) sprintf (err_msg, "Bug! VAR field not logged");
  384.             return (-1);
  385.         }
  386.         break;
  387.         case ABS:  *sp = fabs (*sp); break;
  388.         default:
  389.         (void) sprintf (err_msg, "Bug! bad opcode: 0x%x", instr);
  390.         return (-1);
  391.         }
  392.         if (sp < stack) {
  393.         (void) sprintf (err_msg, "Runtime stack overflow");
  394.         return (-1);
  395.         } else if (sp - stack > MAX_STACK) {
  396.         (void) sprintf (err_msg, "Bug! runtime stack underflow");
  397.         return (-1);
  398.         }
  399.     } while (instr != HALT);
  400.  
  401.     /* result should now be on top of stack */
  402.     if (sp != &stack[MAX_STACK - 1]) {
  403.         (void) sprintf (err_msg, "Bug! stack has %d items",
  404.                             MAX_STACK - (sp-stack));
  405.         return (-1);
  406.     }
  407.     *result = *sp;
  408.     return (0);
  409. }
  410.  
  411. static
  412. isdigit(c)
  413. char c;
  414. {
  415.     return (c >= '0' && c <= '9');
  416. }
  417.  
  418. static
  419. isalpha (c)
  420. char c;
  421. {
  422.     return ((c >= 'a' && c <= 'z') || (c >=  'A' && c <= 'Z'));
  423. }
  424.  
  425. /* starting with lcexpr pointing at a string expected to be a field name,
  426.  * return an rcfpack(r,c,0) of the field else -1 if bad.
  427.  * when return, leave lcexpr alone but move cexpr to just after the name.
  428.  */
  429. static
  430. parse_fieldname ()
  431. {
  432.     int r = -1, c = -1;     /* anything illegal */
  433.     char *fn = lcexpr;    /* likely faster than using the global */
  434.     char f0, f1;
  435.     char *dp;
  436.  
  437.     /* search for first thing not an alpha char.
  438.      * leave it in f0 and leave dp pointing to it.
  439.      */
  440.     dp = fn;
  441.     while (isalpha(f0 = *dp))
  442.         dp++;
  443.  
  444.     /* crack the new field name.
  445.      * when done trying, leave dp pointing at first char just after it.
  446.      * set r and c if we recognized it.
  447.      */
  448.     if (f0 == '.') {
  449.         /* planet.column pair.
  450.          * first crack the planet portion (pointed to by fn): set r.
  451.          * then the second portion (pointed to by dp+1): set c.
  452.          */
  453.         f0 = fn[0];
  454.         f1 = fn[1];
  455.         switch (f0) {
  456.         case 'j':
  457.                     r = R_JUPITER;
  458.         break;
  459.         case 'm':
  460.         if (f1 == 'a')      r = R_MARS;
  461.         else if (f1 == 'e') r = R_MERCURY;
  462.         else if (f1 == 'o') r = R_MOON;
  463.         break;
  464.         case 'n':
  465.                     r = R_NEPTUNE;
  466.         break;
  467.         case 'p':
  468.                     r = R_PLUTO;
  469.         break;
  470.         case 's':
  471.         if (f1 == 'a')      r = R_SATURN;
  472.         else if (f1 == 'u') r = R_SUN;
  473.         break;
  474.         case 'u':
  475.                     r = R_URANUS;
  476.         break;
  477.         case 'x':
  478.                     r = R_OBJX;
  479.         break;
  480.         case 'y':
  481.                     r = R_OBJY;
  482.         break;
  483.         case 'v':
  484.                     r = R_VENUS;
  485.         break;
  486.         }
  487.  
  488.         /* now crack the column (stuff after the dp) */
  489.         dp++;    /* point at good stuff just after the decimal pt */
  490.         f0 = dp[0];
  491.         f1 = dp[1];
  492.         switch (f0) {
  493.         case 'a':
  494.         if (f1 == 'l')        c = C_ALT;
  495.         else if (f1 == 'z')   c = C_AZ;
  496.         break;
  497.         case 'd':
  498.                       c = C_DEC;
  499.         break;
  500.         case 'e':
  501.         if (f1 == 'd')        c = C_EDIST;
  502.         else if (f1 == 'l')   c = C_ELONG;
  503.         break;
  504.         case 'h':
  505.         if (f1 == 'l') {
  506.             if (dp[2] == 'a')              c = C_HLAT;
  507.             else if (dp[2] == 'o')         c = C_HLONG;
  508.         } else if (f1 == 'r' || f1 == 'u') c = C_TUP;
  509.         break;
  510.         case 'j':
  511.                       c = C_JUPITER;
  512.         break;
  513.         case 'm':
  514.         if (f1 == 'a')        c = C_MARS;
  515.         else if (f1 == 'e')   c = C_MERCURY;
  516.         else if (f1 == 'o')   c = C_MOON;
  517.         break;
  518.         case 'n':
  519.                       c = C_NEPTUNE;
  520.         break;
  521.         case 'p':
  522.         if (f1 == 'h')        c = C_PHASE;
  523.         else if (f1 == 'l')   c = C_PLUTO;
  524.         break;
  525.         case 'r':
  526.         if (f1 == 'a') {
  527.             if (dp[2] == 'z') c = C_RISEAZ;
  528.             else           c = C_RA;
  529.         } else if (f1 == 't') c = C_RISETM;
  530.         break;
  531.         case 's':
  532.         if (f1 == 'a') {
  533.             if (dp[2] == 'z') c = C_SETAZ;
  534.             else          c = C_SATURN;
  535.         } else if (f1 == 'd') c = C_SDIST;
  536.         else if (f1 == 'i')   c = C_SIZE;
  537.         else if (f1 == 't')   c = C_SETTM;
  538.         else if (f1 == 'u')   c = C_SUN;
  539.         break;
  540.         case 't':
  541.         if (f1 == 'a')        c = C_TRANSALT;
  542.         else if (f1 == 't')   c = C_TRANSTM;
  543.         break;
  544.         case 'u':
  545.                       c = C_URANUS;
  546.         break;
  547.         case 'x':
  548.                       c = C_OBJX;
  549.         break;
  550.         case 'y':
  551.                       c = C_OBJY;
  552.         break;
  553.         case 'v':
  554.         if (f1 == 'e')        c = C_VENUS;
  555.         else if (f1 == 'm')   c = C_MAG;
  556.         break;
  557.         }
  558.  
  559.         /* now skip dp on past the column stuff */
  560.         while (isalpha(*dp))
  561.         dp++;
  562.     } else {
  563.         /* no decimal point; some field in the top of the screen */
  564.         f0 = fn[0];
  565.         f1 = fn[1];
  566.         switch (f0) {
  567.         case 'd':
  568.         if (f1 == 'a')      r = R_DAWN, c = C_DAWNV;
  569.         else if (f1 == 'u') r = R_DUSK, c = C_DUSKV;
  570.         break;
  571.         case 'n':
  572.         r = R_LON, c = C_LONV;
  573.         break;
  574.         }
  575.     }
  576.  
  577.     cexpr = dp;
  578.     if (r <= 0 || c <= 0) return (-1);
  579.     return (rcfpack (r, c, 0));
  580. }
  581.