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