home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 November / macformat-018.iso / Utility Spectacular / Utilities / Calc / codegen.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-10  |  35.0 KB  |  1,666 lines  |  [TEXT/????]
  1. /*
  2.  * Copyright (c) 1992 David I. Bell
  3.  * Permission is granted to use, distribute, or modify this source,
  4.  * provided that this copyright notice remains intact.
  5.  *
  6.  * Module to generate opcodes from the input tokens.
  7.  */
  8.  
  9. #include "calc.h"
  10. #include "token.h"
  11. #include "symbol.h"
  12. #include "label.h"
  13. #include "opcodes.h"
  14. #include "xstring.h"
  15. #include "func.h"
  16. #include "config.h"
  17.  
  18.  
  19. FUNC *curfunc;
  20.  
  21. static BOOL getfilename(), getid();
  22. static void getshowcommand(), getfunction(), getbody(), getdeclarations();
  23. static void getstatement(), getobjstatement(), getobjvars();
  24. static void getmatstatement(), getsimplebody();
  25. static void getcondition(), getmatargs(), getelement(), checksymbol();
  26. static void getcallargs();
  27. static int getexprlist(), getassignment(), getaltcond(), getorcond();
  28. static int getandcond(), getrelation(), getsum(), getproduct();
  29. static int getorexpr(), getandexpr(), getshiftexpr(), getterm();
  30. static int getidexpr();
  31.  
  32. /*
  33.  * Read all the commands from an input file.
  34.  * These are either declarations, or else are commands to execute now.
  35.  * In general, commands are terminated by newlines or semicolons.
  36.  * Exceptions are function definitions and escaped newlines.
  37.  * Commands are read and executed until the end of file.
  38.  */
  39. void
  40. getcommands()
  41. {
  42.     char name[PATHSIZE+1];    /* program name */
  43.  
  44.     for (;;) {
  45.         tokenmode(TM_NEWLINES);
  46.         switch (gettoken()) {
  47.  
  48.         case T_DEFINE:
  49.             getfunction();
  50.             break;
  51.  
  52.         case T_EOF:
  53.             return;
  54.  
  55.         case T_HELP:
  56.             if (!getfilename(name, FALSE)) {
  57.                 strcpy(name, DEFAULTCALCHELP);
  58.             }
  59.             givehelp(name);
  60.             break;
  61.  
  62.         case T_READ:
  63.             if (!getfilename(name, TRUE))
  64.                 break;
  65.             if (opensearchfile(name, calcpath, CALCEXT) < 0) {
  66.                 scanerror(T_NULL, "Cannot open \"%s\"\n", name);
  67.                 break;
  68.             }
  69.             getcommands();
  70.             break;
  71.  
  72.         case T_WRITE:
  73.             if (!getfilename(name, TRUE))
  74.                 break;
  75.             if (writeglobals(name))
  76.                 scanerror(T_NULL, "Error writing \"%s\"\n", name);
  77.             break;
  78.  
  79.         case T_SHOW:
  80.             rescantoken();
  81.             getshowcommand();
  82.             break;
  83.  
  84.         case T_NEWLINE:
  85.         case T_SEMICOLON:
  86.             break;
  87.  
  88.         default:
  89.             rescantoken();
  90.             initstack();
  91.             if (evaluate(FALSE))
  92.                 updateoldvalue(curfunc);
  93.         }
  94.     }
  95. }
  96.  
  97.  
  98. /*
  99.  * Evaluate a line of statements.
  100.  * This is done by treating the current line as a function body,
  101.  * compiling it, and then executing it.  Returns TRUE if the line
  102.  * successfully compiled and executed.  The last expression result
  103.  * is saved in the f_savedvalue element of the current function.
  104.  * The nestflag variable should be FALSE for the outermost evaluation
  105.  * level, and TRUE for all other calls (such as the 'eval' function).
  106.  * The function name begins with an asterisk to indicate specialness.
  107.  */
  108. BOOL
  109. evaluate(nestflag)
  110.     BOOL nestflag;        /* TRUE if this is a nested evaluation */
  111. {
  112.     char *funcname;
  113.     BOOL gotstatement;
  114.  
  115.     funcname = (nestflag ? "**" : "*");
  116.     beginfunc(funcname, nestflag);
  117.     gotstatement = FALSE;
  118.     for (;;) {
  119.         switch (gettoken()) {
  120.             case T_SEMICOLON:
  121.                 break;
  122.  
  123.             case T_EOF:
  124.                 rescantoken();
  125.                 goto done;
  126.  
  127.             case T_NEWLINE:
  128.                 goto done;
  129.  
  130.             case T_GLOBAL:
  131.             case T_LOCAL:
  132.                 if (gotstatement) {
  133.                     scanerror(T_SEMICOLON, "Declarations must be used before code");
  134.                     return FALSE;
  135.                 }
  136.                 rescantoken();
  137.                 getdeclarations();
  138.                 break;
  139.  
  140.             default:
  141.                 rescantoken();
  142.                 getstatement(NULL, NULL, NULL, NULL);
  143.                 gotstatement = TRUE;
  144.         }
  145.     }
  146.  
  147. done:
  148.     addop(OP_UNDEF);
  149.     addop(OP_RETURN);
  150.     checklabels();
  151.     if (errorcount)
  152.         return FALSE;
  153.     calculate(curfunc, 0);
  154.     return TRUE;
  155. }
  156.  
  157.  
  158. /*
  159.  * Get a function declaration.
  160.  * func = name '(' '' | name [ ',' name] ... ')' simplebody
  161.  *    | name '(' '' | name [ ',' name] ... ')' body.
  162.  */
  163. static void
  164. getfunction()
  165. {
  166.     char *name;        /* parameter name */
  167.     int type;        /* type of token read */
  168.  
  169.     tokenmode(TM_DEFAULT);
  170.     if (gettoken() != T_SYMBOL) {
  171.         scanerror(T_NULL, "Function name expected");
  172.         return;
  173.     }
  174.     beginfunc(tokenstring(), FALSE);
  175.     if (gettoken() != T_LEFTPAREN) {
  176.         scanerror(T_SEMICOLON, "Left parenthesis expected for function");
  177.         return;
  178.     }
  179.     for (;;) {
  180.         type = gettoken();
  181.         if (type == T_RIGHTPAREN)
  182.             break;
  183.         if (type != T_SYMBOL) {
  184.             scanerror(T_COMMA, "Bad function definition");
  185.             return;
  186.         }
  187.         name = tokenstring();
  188.         switch (symboltype(name)) {
  189.             case SYM_UNDEFINED:
  190.             case SYM_GLOBAL:
  191.                 (void) addparam(name);
  192.                 break;
  193.             default:
  194.                 scanerror(T_NULL, "Parameter \"%s\" is already defined", name);
  195.         }
  196.         type = gettoken();
  197.         if (type == T_RIGHTPAREN)
  198.             break;
  199.         if (type != T_COMMA) {
  200.             scanerror(T_COMMA, "Bad function definition");
  201.             return;
  202.         }
  203.     }
  204.     switch (gettoken()) {
  205.         case T_ASSIGN:
  206.             rescantoken();
  207.             getsimplebody();
  208.             break;
  209.         case T_LEFTBRACE:
  210.             rescantoken();
  211.             getbody(NULL, NULL, NULL, NULL, TRUE);
  212.             break;
  213.         default:
  214.             scanerror(T_NULL,
  215.                 "Left brace or equals sign expected for function");
  216.             return;
  217.     }
  218.     addop(OP_UNDEF);
  219.     addop(OP_RETURN);
  220.     endfunc();
  221. }
  222.  
  223.  
  224. /*
  225.  * Get a simple assignment style body for a function declaration.
  226.  * simplebody = '=' assignment '\n'.
  227.  */
  228. static void
  229. getsimplebody()
  230. {
  231.     if (gettoken() != T_ASSIGN) {
  232.         scanerror(T_SEMICOLON, "Missing equals for simple function body");
  233.         return;
  234.     }
  235.     tokenmode(TM_NEWLINES);
  236.     (void) getexprlist();
  237.     addop(OP_RETURN);
  238.     if (gettoken() != T_SEMICOLON)
  239.         rescantoken();
  240.     if (gettoken() != T_NEWLINE)
  241.         scanerror(T_NULL, "Illegal function definition");
  242. }
  243.  
  244.  
  245. /*
  246.  * Get the body of a function, or a subbody of a function.
  247.  * body = '{' [ declarations ] ... [ statement ] ... '}'
  248.  *    | [ declarations ] ... [statement ] ... '\n'
  249.  */
  250. static void
  251. getbody(contlabel, breaklabel, nextcaselabel, defaultlabel, toplevel)
  252.     LABEL *contlabel, *breaklabel, *nextcaselabel, *defaultlabel;
  253.     BOOL toplevel;
  254. {
  255.     BOOL gotstatement;    /* TRUE if seen a real statement yet */
  256.  
  257.     if (gettoken() != T_LEFTBRACE) {
  258.         scanerror(T_SEMICOLON, "Missing left brace for function body");
  259.         return;
  260.     }
  261.     gotstatement = FALSE;
  262.     for (;;) {
  263.         switch (gettoken()) {
  264.         case T_RIGHTBRACE:
  265.             return;
  266.  
  267.         case T_GLOBAL:
  268.         case T_LOCAL:
  269.             if (!toplevel) {
  270.                 scanerror(T_SEMICOLON, "Declarations must be at the top of the function");
  271.                 return;
  272.             }
  273.             if (gotstatement) {
  274.                 scanerror(T_SEMICOLON, "Declarations must be used before code");
  275.                 return;
  276.             }
  277.             rescantoken();
  278.             getdeclarations();
  279.             break;
  280.  
  281.         default:
  282.             rescantoken();
  283.             getstatement(contlabel, breaklabel, nextcaselabel, defaultlabel);
  284.             gotstatement = TRUE;
  285.         }
  286.     }
  287. }
  288.  
  289.  
  290. /*
  291.  * Get a line of local or global variable declarations.
  292.  * declarations = { LOCAL | GLOBAL } name [ ',' name ] ... ';'.
  293.  */
  294. static void
  295. getdeclarations()
  296. {
  297.     int type;        /* type of declaration */
  298.     char *name;        /* name of symbol seen */
  299.  
  300.     switch (gettoken()) {
  301.         case T_LOCAL:
  302.             type = SYM_LOCAL;
  303.             break;
  304.         case T_GLOBAL:
  305.             type = SYM_GLOBAL;
  306.             break;
  307.         default:
  308.             rescantoken();
  309.             return;
  310.     }
  311.     for (;;) {
  312.         if (gettoken() != T_SYMBOL) {
  313.             scanerror(T_SEMICOLON, "Variable name expected for declaration statement");
  314.             return;
  315.         }
  316.         name = tokenstring();
  317.         switch (symboltype(name)) {
  318.         case SYM_UNDEFINED:
  319.         case SYM_GLOBAL:
  320.             if (type == SYM_LOCAL)
  321.                 (void) addlocal(name);
  322.             else
  323.                 (void) addglobal(name);
  324.             break;
  325.         case SYM_PARAM:
  326.         case SYM_LOCAL:
  327.             scanerror(T_NULL, "variable \"%s\" is already defined", name);
  328.             break;
  329.         }
  330.         switch (gettoken()) {
  331.             case T_COMMA:
  332.                 break;
  333.             case T_NEWLINE:
  334.             case T_SEMICOLON:
  335.                 return;
  336.             default:
  337.                 scanerror(T_SEMICOLON, "Bad syntax in declaration statement");
  338.                 return;
  339.         }
  340.     }
  341. }
  342.  
  343.  
  344. /*
  345.  * Get a statement.
  346.  * statement = IF condition statement [ELSE statement]
  347.  *    | FOR '(' [assignment] ';' [assignment] ';' [assignment] ')' statement
  348.  *    | WHILE condition statement
  349.  *    | DO statement WHILE condition ';'
  350.  *    | SWITCH condition '{' [caseclause] ... '}'
  351.  *    | CONTINUE ';'
  352.  *    | BREAK ';'
  353.  *    | RETURN assignment ';'
  354.  *    | GOTO label ';'
  355.  *    | MAT name '[' value [ ':' value ] [',' value [ ':' value ] ] ']' ';'
  356.  *    | OBJ type '{' arg [ ',' arg ] ... '}' ] ';'
  357.  *    | OBJ type name [ ',' name ] ';'
  358.  *    | PRINT assignment [, assignment ] ... ';'
  359.  *    | QUIT [ string ] ';'
  360.  *    | SHOW item ';'
  361.  *    | body
  362.  *    | assignment ';'
  363.  *    | label ':' statement
  364.  *    | ';'.
  365.  */
  366. static void
  367. getstatement(contlabel, breaklabel, nextcaselabel, defaultlabel)
  368.     LABEL *contlabel;    /* label for continue statement */
  369.     LABEL *breaklabel;    /* label for break statement */
  370.     LABEL *nextcaselabel;    /* label for next case statement */
  371.     LABEL *defaultlabel;    /* label for default case */
  372. {
  373.     LABEL label1, label2, label3, label4;    /* locations for jumps */
  374.     int type;
  375.     BOOL printeol;
  376.  
  377.     addopindex(OP_DEBUG, linenumber());
  378.     switch (gettoken()) {
  379.     case T_NEWLINE:
  380.         rescantoken();
  381.         return;
  382.  
  383.     case T_SEMICOLON:
  384.         return;
  385.  
  386.     case T_RIGHTBRACE:
  387.         scanerror(T_NULL, "Extraneous right brace");
  388.         return;
  389.  
  390.     case T_CONTINUE:
  391.         if (contlabel == NULL) {
  392.             scanerror(T_SEMICOLON, "CONTINUE not within FOR, WHILE, or DO");
  393.             return;
  394.         }
  395.         addoplabel(OP_JUMP, contlabel);
  396.         break;
  397.  
  398.     case T_BREAK:
  399.         if (breaklabel == NULL) {
  400.             scanerror(T_SEMICOLON, "BREAK not within FOR, WHILE, or DO");
  401.             return;
  402.         }
  403.         addoplabel(OP_JUMP, breaklabel);
  404.         break;
  405.  
  406.     case T_GOTO:
  407.         if (gettoken() != T_SYMBOL) {
  408.             scanerror(T_SEMICOLON, "Missing label in goto");
  409.             return;
  410.         }
  411.         addop(OP_JUMP);
  412.         addlabel(tokenstring());
  413.         break;
  414.  
  415.     case T_RETURN:
  416.         switch (gettoken()) {
  417.             case T_NEWLINE:
  418.             case T_SEMICOLON:
  419.                 addop(OP_UNDEF);
  420.                 addop(OP_RETURN);
  421.                 return;
  422.             default:
  423.                 rescantoken();
  424.                 (void) getexprlist();
  425.                 if (curfunc->f_name[0] == '*')
  426.                     addop(OP_SAVE);
  427.                 addop(OP_RETURN);
  428.         }
  429.         break;
  430.  
  431.     case T_LEFTBRACE:
  432.         rescantoken();
  433.         getbody(contlabel, breaklabel, nextcaselabel, defaultlabel, FALSE);
  434.         return;
  435.  
  436.     case T_IF:
  437.         clearlabel(&label1);
  438.         clearlabel(&label2);
  439.         getcondition();
  440.         addoplabel(OP_JUMPEQ, &label1);
  441.         getstatement(contlabel, breaklabel, (LABEL*)NULL, (LABEL*)NULL);
  442.         if (gettoken() != T_ELSE) {
  443.             setlabel(&label1);
  444.             rescantoken();
  445.             return;
  446.         }
  447.         addoplabel(OP_JUMP, &label2);
  448.         setlabel(&label1);
  449.         getstatement(contlabel, breaklabel, (LABEL*)NULL, (LABEL*)NULL);
  450.         setlabel(&label2);
  451.         return;
  452.  
  453.     case T_FOR:    /* for (a; b; c) x */
  454.         clearlabel(&label1);
  455.         clearlabel(&label2);
  456.         clearlabel(&label3);
  457.         clearlabel(&label4);
  458.         contlabel = NULL;
  459.         breaklabel = &label4;
  460.         if (gettoken() != T_LEFTPAREN) {
  461.             scanerror(T_SEMICOLON, "Left parenthesis expected");
  462.             return;
  463.         }
  464.         if (gettoken() != T_SEMICOLON) {    /* have 'a' part */
  465.             rescantoken();
  466.             (void) getexprlist();
  467.             addop(OP_POP);
  468.             if (gettoken() != T_SEMICOLON) {
  469.                 scanerror(T_SEMICOLON, "Missing semicolon");
  470.                 return;
  471.             }
  472.         }
  473.         if (gettoken() != T_SEMICOLON) {    /* have 'b' part */
  474.             setlabel(&label1);
  475.             contlabel = &label1;
  476.             rescantoken();
  477.             (void) getexprlist();
  478.             addoplabel(OP_JUMPNE, &label3);
  479.             addoplabel(OP_JUMP, breaklabel);
  480.             if (gettoken() != T_SEMICOLON) {
  481.                 scanerror(T_SEMICOLON, "Missing semicolon");
  482.                 return;
  483.             }
  484.         }
  485.         if (gettoken() != T_RIGHTPAREN) {    /* have 'c' part */
  486.             if (label1.l_offset <= 0)
  487.                 addoplabel(OP_JUMP, &label3);
  488.             setlabel(&label2);
  489.             contlabel = &label2;
  490.             rescantoken();
  491.             (void) getexprlist();
  492.             addop(OP_POP);
  493.             if (label1.l_offset > 0)
  494.                 addoplabel(OP_JUMP, &label1);
  495.             if (gettoken() != T_RIGHTPAREN) {
  496.                 scanerror(T_SEMICOLON, "Right parenthesis expected");
  497.                 return;
  498.             }
  499.         }
  500.         setlabel(&label3);
  501.         if (contlabel == NULL)
  502.             contlabel = &label3;
  503.         getstatement(contlabel, breaklabel, (LABEL*)NULL, (LABEL*)NULL);
  504.         addoplabel(OP_JUMP, contlabel);
  505.         setlabel(breaklabel);
  506.         return;
  507.  
  508.     case T_WHILE:
  509.         contlabel = &label1;
  510.         breaklabel = &label2;
  511.         clearlabel(contlabel);
  512.         clearlabel(breaklabel);
  513.         setlabel(contlabel);
  514.         getcondition();
  515.         addoplabel(OP_JUMPEQ, breaklabel);
  516.         getstatement(contlabel, breaklabel, (LABEL*)NULL, (LABEL*)NULL);
  517.         addoplabel(OP_JUMP, contlabel);
  518.         setlabel(breaklabel);
  519.         return;
  520.  
  521.     case T_DO:
  522.         contlabel = &label1;
  523.         breaklabel = &label2;
  524.         clearlabel(contlabel);
  525.         clearlabel(breaklabel);
  526.         clearlabel(&label3);
  527.         setlabel(&label3);
  528.         getstatement(contlabel, breaklabel, (LABEL*)NULL, (LABEL*)NULL);
  529.         if (gettoken() != T_WHILE) {
  530.             scanerror(T_SEMICOLON, "WHILE keyword expected for DO statement");
  531.             return;
  532.         }
  533.         setlabel(contlabel);
  534.         getcondition();
  535.         addoplabel(OP_JUMPNE, &label3);
  536.         setlabel(breaklabel);
  537.         return;
  538.  
  539.     case T_SWITCH:
  540.         breaklabel = &label1;
  541.         nextcaselabel = &label2;
  542.         defaultlabel = &label3;
  543.         clearlabel(breaklabel);
  544.         clearlabel(nextcaselabel);
  545.         clearlabel(defaultlabel);
  546.         getcondition();
  547.         if (gettoken() != T_LEFTBRACE) {
  548.             scanerror(T_SEMICOLON, "Missing left brace for switch statement");
  549.             return;
  550.         }
  551.         addoplabel(OP_JUMP, nextcaselabel);
  552.         rescantoken();
  553.         getstatement(contlabel, breaklabel, nextcaselabel, defaultlabel);
  554.         addoplabel(OP_JUMP, breaklabel);
  555.         setlabel(nextcaselabel);
  556.         if (defaultlabel->l_offset > 0)
  557.             addoplabel(OP_JUMP, defaultlabel);
  558.         else
  559.             addop(OP_POP);
  560.         setlabel(breaklabel);
  561.         return;
  562.  
  563.     case T_CASE:
  564.         if (nextcaselabel == NULL) {
  565.             scanerror(T_SEMICOLON, "CASE not within SWITCH statement");
  566.             return;
  567.         }
  568.         clearlabel(&label1);
  569.         addoplabel(OP_JUMP, &label1);
  570.         setlabel(nextcaselabel);
  571.         clearlabel(nextcaselabel);
  572.         (void) getexprlist();
  573.         if (gettoken() != T_COLON) {
  574.             scanerror(T_SEMICOLON, "Colon expected after CASE expression");
  575.             return;
  576.         }
  577.         addoplabel(OP_CASEJUMP, nextcaselabel);
  578.         setlabel(&label1);
  579.         getstatement(contlabel, breaklabel, nextcaselabel, defaultlabel);
  580.         return;
  581.  
  582.     case T_DEFAULT:
  583.         if (gettoken() != T_COLON) {
  584.             scanerror(T_SEMICOLON, "Colon expected after DEFAULT keyword");
  585.             return;
  586.         }
  587.         if (defaultlabel == NULL) {
  588.             scanerror(T_SEMICOLON, "DEFAULT not within SWITCH statement");
  589.             return;
  590.         }
  591.         if (defaultlabel->l_offset > 0) {
  592.             scanerror(T_SEMICOLON, "Multiple DEFAULT clauses in SWITCH");
  593.             return;
  594.         }
  595.         clearlabel(&label1);
  596.         addoplabel(OP_JUMP, &label1);
  597.         setlabel(defaultlabel);
  598.         addop(OP_POP);
  599.         setlabel(&label1);
  600.         getstatement(contlabel, breaklabel, nextcaselabel, defaultlabel);
  601.         return;
  602.  
  603.     case T_ELSE:
  604.         scanerror(T_SEMICOLON, "ELSE without preceeding IF");
  605.         return;
  606.  
  607.     case T_MAT:
  608.         getmatstatement();
  609.         break;
  610.  
  611.     case T_OBJ:
  612.         getobjstatement();
  613.         break;
  614.  
  615.     case T_PRINT:
  616.         printeol = TRUE;
  617.         for (;;) {
  618.             switch (gettoken()) {
  619.                 case T_RIGHTBRACE:
  620.                 case T_NEWLINE:
  621.                     rescantoken();
  622.                     /*FALLTHRU*/
  623.                 case T_SEMICOLON:
  624.                     if (printeol)
  625.                         addop(OP_PRINTEOL);
  626.                     return;
  627.                 case T_COLON:
  628.                     printeol = FALSE;
  629.                     break;
  630.                 case T_COMMA:
  631.                     printeol = TRUE;
  632.                     addop(OP_PRINTSPACE);
  633.                     break;
  634.                 case T_STRING:
  635.                     printeol = TRUE;
  636.                     addopptr(OP_PRINTSTRING, tokenstring());
  637.                     break;
  638.                 default:
  639.                     printeol = TRUE;
  640.                     rescantoken();
  641.                     (void) getassignment();
  642.                     addopindex(OP_PRINT,
  643.                         (long) PRINT_NORMAL);
  644.             }
  645.         }
  646.         break;
  647.  
  648.     case T_QUIT:
  649.         switch (gettoken()) {
  650.             case T_STRING:
  651.                 addopptr(OP_QUIT, tokenstring());
  652.                 break;
  653.             default:
  654.                 addopptr(OP_QUIT, NULL);
  655.                 rescantoken();
  656.         }
  657.         break;
  658.  
  659.     case T_SYMBOL:
  660.         if (nextchar() == ':') {    /****HACK HACK ****/
  661.             definelabel(tokenstring());
  662.             getstatement(contlabel, breaklabel, 
  663.                 (LABEL*)NULL, (LABEL*)NULL);
  664.             return;
  665.         }
  666.         reread();
  667.         /* fall into default case */
  668.  
  669.     default:
  670.         rescantoken();
  671.         type = getexprlist();
  672.         if (contlabel || breaklabel || (curfunc->f_name[0] != '*')) {
  673.             addop(OP_POP);
  674.             break;
  675.         }
  676.         addop(OP_SAVE);
  677.         if (isassign(type) || (curfunc->f_name[1] != '\0')) {
  678.             addop(OP_POP);
  679.             break;
  680.         }
  681.         addop(OP_PRINTRESULT);
  682.         break;
  683.     }
  684.     switch (gettoken()) {
  685.         case T_RIGHTBRACE:
  686.         case T_NEWLINE:
  687.             rescantoken();
  688.             break;
  689.         case T_SEMICOLON:
  690.             break;
  691.         default:
  692.             scanerror(T_SEMICOLON, "Semicolon expected");
  693.             break;
  694.     }
  695. }
  696.  
  697.  
  698. /*
  699.  * Read in an object definition statement.
  700.  * This is of the following form:
  701.  *    OBJ type [ '{' id [ ',' id ] ... '}' ]  [ objlist ].
  702.  * The OBJ keyword has already been read.
  703.  */
  704. static void
  705. getobjstatement()
  706. {
  707.     char *name;            /* name of object type */
  708.     int count;            /* number of elements */
  709.     int index;            /* current index */
  710.     int i;                /* loop counter */
  711.     BOOL err;            /* error flag */
  712.     int indices[MAXINDICES];    /* indices for elements */
  713.  
  714.     err = FALSE;
  715.     if (gettoken() != T_SYMBOL) {
  716.         scanerror(T_SEMICOLON, "Object type name missing");
  717.         return;
  718.     }
  719.     name = addliteral(tokenstring());
  720.     if (gettoken() != T_LEFTBRACE) {
  721.         rescantoken();
  722.         getobjvars(name);
  723.         return;
  724.     }
  725.     /*
  726.      * Read in the definition of the elements of the object.
  727.      */
  728.     count = 0;
  729.     for (;;) {
  730.         if (gettoken() != T_SYMBOL) {
  731.             scanerror(T_SEMICOLON, "Missing element name in OBJ statement");
  732.             return;
  733.         }
  734.         index = addelement(tokenstring());
  735.         for (i = 0; i < count; i++) {
  736.             if (indices[i] == index) {
  737.                 scanerror(T_NULL, "Duplicate element name \"%s\"", tokenstring());
  738.                 err = TRUE;
  739.                 break;
  740.             }
  741.         }
  742.         indices[count++] = index;
  743.         switch (gettoken()) {
  744.             case T_RIGHTBRACE:
  745.                 if (!err)
  746.                     (void) defineobject(name, indices, count);
  747.                 switch (gettoken()) {
  748.                     case T_SEMICOLON:
  749.                     case T_NEWLINE:
  750.                         rescantoken();
  751.                         return;
  752.                 }
  753.                 rescantoken();
  754.                 getobjvars(name);
  755.                 return;
  756.             case T_COMMA:
  757.             case T_SEMICOLON:
  758.             case T_NEWLINE:
  759.                 break;
  760.             default:
  761.                 scanerror(T_SEMICOLON, "Bad object element definition");
  762.                 return;
  763.         }
  764.     }
  765. }
  766.  
  767.  
  768. /*
  769.  * Routine to collect a set of variables for the specified object type
  770.  * and initialize them as being that type of object.
  771.  * Here
  772.  *    objlist = name [ ',' name] ... ';'.
  773.  */
  774. static void
  775. getobjvars(name)
  776.     char *name;        /* object name */
  777. {
  778.     long index;        /* index for object */
  779.  
  780.     index = checkobject(name);
  781.     if (index < 0) {
  782.         scanerror(T_SEMICOLON, "Object %s has not been defined yet", name);
  783.         return;
  784.     }
  785.     for (;;) {
  786.         (void) getidexpr(TRUE, TRUE);
  787.         addopindex(OP_OBJINIT, index);
  788.         switch (gettoken()) {
  789.             case T_COMMA:
  790.                 break;
  791.             case T_SEMICOLON:
  792.             case T_NEWLINE:
  793.                 rescantoken();
  794.                 return;
  795.             default:
  796.                 scanerror(T_SEMICOLON, "Bad OBJ statement");
  797.                 return;
  798.         }
  799.     }
  800. }
  801.  
  802.  
  803. /*
  804.  * Read a matrix definition statment for a one or more dimensional matrix.
  805.  * The MAT keyword has already been read.
  806.  */
  807. static void
  808. getmatstatement()
  809. {
  810.     int dim;        /* dimension of matrix */
  811.  
  812.     (void) getidexpr(FALSE, TRUE);
  813.     if (gettoken() != T_LEFTBRACKET) {
  814.         scanerror(T_SEMICOLON, "Missing left bracket for MAT");
  815.         return;
  816.     }
  817.     dim = 1;
  818.     for (;;) {
  819.         (void) getassignment();
  820.         switch (gettoken()) {
  821.             case T_RIGHTBRACKET:
  822.             case T_COMMA:
  823.                 rescantoken();
  824.                 addop(OP_ONE);
  825.                 addop(OP_SUB);
  826.                 addop(OP_ZERO);
  827.                 break;
  828.             case T_COLON:
  829.                 (void) getassignment();
  830.                 break;
  831.             default:
  832.                 rescantoken();
  833.         }
  834.         switch (gettoken()) {
  835.             case T_RIGHTBRACKET:
  836.                 if (gettoken() != T_LEFTBRACKET) {
  837.                     rescantoken();
  838.                     addopindex(OP_MATINIT, (long) dim);
  839.                     return;
  840.                 }
  841.                 /* proceed into comma case */
  842.                 /*FALLTHRU*/
  843.             case T_COMMA:
  844.                 if (++dim <= MAXDIM)
  845.                     break;
  846.                 scanerror(T_SEMICOLON, "Only %d dimensions allowed", MAXDIM);
  847.                 return;
  848.             default:
  849.                 scanerror(T_SEMICOLON, "Illegal matrix definition");
  850.                 return;
  851.         }
  852.     }
  853. }
  854.  
  855.  
  856. /*
  857.  * Get a condition.
  858.  * condition = '(' assignment ')'.
  859.  */
  860. static void
  861. getcondition()
  862. {
  863.     if (gettoken() != T_LEFTPAREN) {
  864.         scanerror(T_SEMICOLON, "Missing left parenthesis for condition");
  865.         return;
  866.     }
  867.     (void) getexprlist();
  868.     if (gettoken() != T_RIGHTPAREN) {
  869.         scanerror(T_SEMICOLON, "Missing right parenthesis for condition");
  870.         return;
  871.     }
  872. }
  873.  
  874.  
  875. /*
  876.  * Get an expression list consisting of one or more expressions,
  877.  * separated by commas.  The value of the list is that of the final expression.
  878.  * This is the top level routine for parsing expressions.
  879.  * Returns flags describing the type of assignment or expression found.
  880.  * exprlist = assignment [ ',' assignment ] ...
  881.  */
  882. static int
  883. getexprlist()
  884. {
  885.     int    type;
  886.  
  887.     type = getassignment();
  888.     while (gettoken() == T_COMMA) {
  889.         addop(OP_POP);
  890.         (void) getassignment();
  891.         type = EXPR_RVALUE;
  892.     }
  893.     rescantoken();
  894.     return type;
  895. }
  896.  
  897.  
  898. /*
  899.  * Get an assignment (or possibly just an expression).
  900.  * Returns flags describing the type of assignment or expression found.
  901.  * assignment = lvalue '=' assignment
  902.  *    | lvalue '+=' assignment
  903.  *    | lvalue '-=' assignment
  904.  *    | lvalue '*=' assignment
  905.  *    | lvalue '/=' assignment
  906.  *    | lvalue '%=' assignment
  907.  *    | lvalue '//=' assignment
  908.  *    | lvalue '&=' assignment
  909.  *    | lvalue '|=' assignment
  910.  *    | lvalue '<<=' assignment
  911.  *    | lvalue '>>=' assignment
  912.  *    | lvalue '^=' assignment
  913.  *    | lvalue '**=' assignment
  914.  *    | orcond.
  915.  */
  916. static int
  917. getassignment()
  918. {
  919.     int type;        /* type of expression */
  920.     long op;        /* opcode to generate */
  921.  
  922.     type = getaltcond();
  923.     switch (gettoken()) {
  924.         case T_ASSIGN:        op = 0; break;
  925.         case T_PLUSEQUALS:    op = OP_ADD; break;
  926.         case T_MINUSEQUALS:    op = OP_SUB; break;
  927.         case T_MULTEQUALS:    op = OP_MUL; break;
  928.         case T_DIVEQUALS:    op = OP_DIV; break;
  929.         case T_SLASHSLASHEQUALS: op = OP_QUO; break;
  930.         case T_MODEQUALS:    op = OP_MOD; break;
  931.         case T_ANDEQUALS:    op = OP_AND; break;
  932.         case T_OREQUALS:    op = OP_OR; break;
  933.         case T_LSHIFTEQUALS:     op = OP_LEFTSHIFT; break;
  934.         case T_RSHIFTEQUALS:     op = OP_RIGHTSHIFT; break;
  935.         case T_POWEREQUALS:    op = OP_POWER; break;
  936.  
  937.         case T_NUMBER:
  938.         case T_IMAGINARY:
  939.         case T_STRING:
  940.         case T_SYMBOL:
  941.         case T_OLDVALUE:
  942.         case T_LEFTPAREN:
  943.         case T_PLUSPLUS:
  944.         case T_MINUSMINUS:
  945.         case T_NOT:
  946.             scanerror(T_NULL, "Missing operator");
  947.             return type;
  948.  
  949.         default:
  950.             rescantoken();
  951.             return type;
  952.     }
  953.     if (isrvalue(type)) {
  954.         scanerror(T_NULL, "Illegal assignment");
  955.         (void) getassignment();
  956.         return (EXPR_RVALUE | EXPR_ASSIGN);
  957.     }
  958.     if (op)
  959.         addop(OP_DUPLICATE);
  960.     (void) getassignment();
  961.     if (op) {
  962.         addop(op);
  963.     }
  964.     addop(OP_ASSIGN);
  965.     return (EXPR_RVALUE | EXPR_ASSIGN);
  966. }
  967.  
  968.  
  969. /*
  970.  * Get a possible conditional result expression (question mark).
  971.  * Flags are returned indicating the type of expression found.
  972.  * altcond = orcond [ '?' orcond ':' altcond ].
  973.  */
  974. static int
  975. getaltcond()
  976. {
  977.     int type;        /* type of expression */
  978.     LABEL donelab;        /* label for done */
  979.     LABEL altlab;        /* label for alternate expression */
  980.  
  981.     type = getorcond();
  982.     if (gettoken() != T_QUESTIONMARK) {
  983.         rescantoken();
  984.         return type;
  985.     }
  986.     clearlabel(&donelab);
  987.     clearlabel(&altlab);
  988.     addoplabel(OP_JUMPEQ, &altlab);
  989.     (void) getorcond();
  990.     if (gettoken() != T_COLON) {
  991.         scanerror(T_SEMICOLON, "Missing colon for conditional expression");
  992.         return EXPR_RVALUE;
  993.     }
  994.     addoplabel(OP_JUMP, &donelab);
  995.     setlabel(&altlab);
  996.     (void) getaltcond();
  997.     setlabel(&donelab);
  998.     return EXPR_RVALUE;
  999. }
  1000.  
  1001.  
  1002. /*
  1003.  * Get a possible conditional or expression.
  1004.  * Flags are returned indicating the type of expression found.
  1005.  * orcond = andcond [ '||' andcond ] ...
  1006.  */
  1007. static int
  1008. getorcond()
  1009. {
  1010.     int type;        /* type of expression */
  1011.     LABEL donelab;        /* label for done */
  1012.  
  1013.     clearlabel(&donelab);
  1014.     type = getandcond();
  1015.     while (gettoken() == T_OROR) {
  1016.         addoplabel(OP_CONDORJUMP, &donelab);
  1017.         (void) getandcond();
  1018.         type = EXPR_RVALUE;
  1019.     }
  1020.     rescantoken();
  1021.     if (donelab.l_chain > 0)
  1022.         setlabel(&donelab);
  1023.     return type;
  1024. }
  1025.  
  1026.  
  1027. /*
  1028.  * Get a possible conditional and expression.
  1029.  * Flags are returned indicating the type of expression found.
  1030.  * andcond = relation [ '&&' relation ] ...
  1031.  */
  1032. static int
  1033. getandcond()
  1034. {
  1035.     int type;        /* type of expression */
  1036.     LABEL donelab;        /* label for done */
  1037.  
  1038.     clearlabel(&donelab);
  1039.     type = getrelation();
  1040.     while (gettoken() == T_ANDAND) {
  1041.         addoplabel(OP_CONDANDJUMP, &donelab);
  1042.         (void) getrelation();
  1043.         type = EXPR_RVALUE;
  1044.     }
  1045.     rescantoken();
  1046.     if (donelab.l_chain > 0)
  1047.         setlabel(&donelab);
  1048.     return type;
  1049. }
  1050.  
  1051.  
  1052. /*
  1053.  * Get a possible relation (equality or inequality), or just an expression.
  1054.  * Flags are returned indicating the type of relation found.
  1055.  * relation = sum '==' sum
  1056.  *    | sum '!=' sum
  1057.  *    | sum '<=' sum
  1058.  *    | sum '>=' sum
  1059.  *    | sum '<' sum
  1060.  *    | sum '>' sum
  1061.  *    | sum.
  1062.  */
  1063. static int
  1064. getrelation()
  1065. {
  1066.     int type;        /* type of expression */
  1067.     long op;        /* opcode to generate */
  1068.  
  1069.     type = getsum();
  1070.     switch (gettoken()) {
  1071.         case T_EQ: op = OP_EQ; break;
  1072.         case T_NE: op = OP_NE; break;
  1073.         case T_LT: op = OP_LT; break;
  1074.         case T_GT: op = OP_GT; break;
  1075.         case T_LE: op = OP_LE; break;
  1076.         case T_GE: op = OP_GE; break;
  1077.         default:
  1078.             rescantoken();
  1079.             return type;
  1080.     }
  1081.     (void) getsum();
  1082.     addop(op);
  1083.     return EXPR_RVALUE;
  1084. }
  1085.  
  1086.  
  1087. /*
  1088.  * Get an expression made up of sums of products.
  1089.  * Flags indicating the type of expression found are returned.
  1090.  * sum = product [ {'+' | '-'} product ] ...
  1091.  */
  1092. static int
  1093. getsum()
  1094. {
  1095.     int type;        /* type of expression found */
  1096.     long op;        /* opcode to generate */
  1097.  
  1098.     type = getproduct();
  1099.     for (;;) {
  1100.         switch (gettoken()) {
  1101.             case T_PLUS:    op = OP_ADD; break;
  1102.             case T_MINUS:    op = OP_SUB; break;
  1103.             default:
  1104.                 rescantoken();
  1105.                 return type;
  1106.         }
  1107.         (void) getproduct();
  1108.         addop(op);
  1109.         type = EXPR_RVALUE;
  1110.     }
  1111. }
  1112.  
  1113.  
  1114. /*
  1115.  * Get the product of arithmetic or expressions.
  1116.  * Flags indicating the type of expression found are returned.
  1117.  * product = orexpr [ {'*' | '/' | '//' | '%'} orexpr ] ...
  1118.  */
  1119. static int
  1120. getproduct()
  1121. {
  1122.     int type;        /* type of value found */
  1123.     long op;        /* opcode to generate */
  1124.  
  1125.     type = getorexpr();
  1126.     for (;;) {
  1127.         switch (gettoken()) {
  1128.             case T_MULT:    op = OP_MUL; break;
  1129.             case T_DIV:    op = OP_DIV; break;
  1130.             case T_MOD:    op = OP_MOD; break;
  1131.             case T_SLASHSLASH: op = OP_QUO; break;
  1132.             default:
  1133.                 rescantoken();
  1134.                 return type;
  1135.         }
  1136.         (void) getorexpr();
  1137.         addop(op);
  1138.         type = EXPR_RVALUE;
  1139.     }
  1140. }
  1141.  
  1142.  
  1143. /*
  1144.  * Get an expression made up of arithmetic or operators.
  1145.  * Flags indicating the type of expression found are returned.
  1146.  * orexpr = andexpr [ '|' andexpr ] ...
  1147.  */
  1148. static int
  1149. getorexpr()
  1150. {
  1151.     int type;        /* type of value found */
  1152.  
  1153.     type = getandexpr();
  1154.     while (gettoken() == T_OR) {
  1155.         (void) getandexpr();
  1156.         addop(OP_OR);
  1157.         type = EXPR_RVALUE;
  1158.     }
  1159.     rescantoken();
  1160.     return type;
  1161. }
  1162.  
  1163.  
  1164. /*
  1165.  * Get an expression made up of arithmetic and operators.
  1166.  * Flags indicating the type of expression found are returned.
  1167.  * andexpr = shiftexpr [ '&' shiftexpr ] ...
  1168.  */
  1169. static int
  1170. getandexpr()
  1171. {
  1172.     int type;        /* type of value found */
  1173.  
  1174.     type = getshiftexpr();
  1175.     while (gettoken() == T_AND) {
  1176.         (void) getshiftexpr();
  1177.         addop(OP_AND);
  1178.         type = EXPR_RVALUE;
  1179.     }
  1180.     rescantoken();
  1181.     return type;
  1182. }
  1183.  
  1184.  
  1185. /*
  1186.  * Get a shift or power expression.
  1187.  * Flags indicating the type of expression found are returned.
  1188.  * shift = term '^' shiftexpr
  1189.  *     | term '<<' shiftexpr
  1190.  *     | term '>>' shiftexpr
  1191.  *     | term.
  1192.  */
  1193. static int
  1194. getshiftexpr()
  1195. {
  1196.     int type;        /* type of value found */
  1197.     long op;        /* opcode to generate */
  1198.  
  1199.     type = getterm();
  1200.     switch (gettoken()) {
  1201.         case T_POWER:        op = OP_POWER; break;
  1202.         case T_LEFTSHIFT:    op = OP_LEFTSHIFT; break;
  1203.         case T_RIGHTSHIFT:     op = OP_RIGHTSHIFT; break;
  1204.         default:
  1205.             rescantoken();
  1206.             return type;
  1207.     }
  1208.     (void) getshiftexpr();
  1209.     addop(op);
  1210.     return EXPR_RVALUE;
  1211. }
  1212.  
  1213.  
  1214. /*
  1215.  * Get a single term.
  1216.  * Flags indicating the type of value found are returned.
  1217.  * term = lvalue
  1218.  *    | lvalue '[' assignment ']'
  1219.  *    | lvalue '++'
  1220.  *    | lvalue '--'
  1221.  *    | '++' lvalue
  1222.  *    | '--' lvalue
  1223.  *    | real_number
  1224.  *    | imaginary_number
  1225.  *    | '.'
  1226.  *    | string
  1227.  *    | '(' assignment ')'
  1228.  *    | function [ '(' [assignment  [',' assignment] ] ')' ]
  1229.  *    | '!' term
  1230.  *    | '+' term
  1231.  *    | '-' term.
  1232.  */
  1233. static int
  1234. getterm()
  1235. {
  1236.     int type;        /* type of term found */
  1237.  
  1238.     type = gettoken();
  1239.     switch (type) {
  1240.         case T_NUMBER:
  1241.             addopindex(OP_NUMBER, tokennumber());
  1242.             type = (EXPR_RVALUE | EXPR_CONST);
  1243.             break;
  1244.  
  1245.         case T_IMAGINARY:
  1246.             addopindex(OP_IMAGINARY, tokennumber());
  1247.             type = (EXPR_RVALUE | EXPR_CONST);
  1248.             break;
  1249.  
  1250.         case T_OLDVALUE:
  1251.             addop(OP_OLDVALUE);
  1252.             type = 0;
  1253.             break;
  1254.  
  1255.         case T_STRING:
  1256.             addopptr(OP_STRING, tokenstring());
  1257.             type = (EXPR_RVALUE | EXPR_CONST);
  1258.             break;
  1259.  
  1260.         case T_PLUSPLUS:
  1261.             if (isrvalue(getterm()))
  1262.                 scanerror(T_NULL, "Bad ++ usage");
  1263.             addop(OP_PREINC);
  1264.             type = (EXPR_RVALUE | EXPR_ASSIGN);
  1265.             break;
  1266.  
  1267.         case T_MINUSMINUS:
  1268.             if (isrvalue(getterm()))
  1269.                 scanerror(T_NULL, "Bad -- usage");
  1270.             addop(OP_PREDEC);
  1271.             type = (EXPR_RVALUE | EXPR_ASSIGN);
  1272.             break;
  1273.  
  1274.         case T_NOT:
  1275.             (void) getterm();
  1276.             addop(OP_NOT);
  1277.             type = EXPR_RVALUE;
  1278.             break;
  1279.  
  1280.         case T_MINUS:
  1281.             (void) getterm();
  1282.             addop(OP_NEGATE);
  1283.             type = EXPR_RVALUE;
  1284.             break;
  1285.  
  1286.         case T_PLUS:
  1287.             (void) getterm();
  1288.             type = EXPR_RVALUE;
  1289.             break;
  1290.  
  1291.         case T_LEFTPAREN:
  1292.             type = getexprlist();
  1293.             if (gettoken() != T_RIGHTPAREN)
  1294.                 scanerror(T_SEMICOLON, "Missing right parenthesis");
  1295.             break;
  1296.  
  1297.         case T_SYMBOL:
  1298.             rescantoken();
  1299.             type = getidexpr(TRUE, FALSE);
  1300.             break;
  1301.  
  1302.         case T_LEFTBRACKET:
  1303.             scanerror(T_NULL, "Bad index usage");
  1304.             type = 0;
  1305.             break;
  1306.  
  1307.         case T_PERIOD:
  1308.             scanerror(T_NULL, "Bad element reference");
  1309.             type = 0;
  1310.             break;
  1311.  
  1312.         default:
  1313.             if (iskeyword(type)) {
  1314.                 scanerror(T_NULL, "Expression contains reserved keyword");
  1315.                 type = 0;
  1316.                 break;
  1317.             }
  1318.             rescantoken();
  1319.             scanerror(T_NULL, "Missing expression");
  1320.             type = 0;
  1321.     }
  1322.     switch (gettoken()) {
  1323.         case T_PLUSPLUS:
  1324.             if (isrvalue(type))
  1325.                 scanerror(T_NULL, "Bad ++ usage");
  1326.             addop(OP_POSTINC);
  1327.             return (EXPR_RVALUE | EXPR_ASSIGN);
  1328.         case T_MINUSMINUS:
  1329.             if (isrvalue(type))
  1330.                 scanerror(T_NULL, "Bad -- usage");
  1331.             addop(OP_POSTDEC);
  1332.             return (EXPR_RVALUE | EXPR_ASSIGN);
  1333.         default:
  1334.             rescantoken();
  1335.             return type;
  1336.     }
  1337. }
  1338.  
  1339.  
  1340. /*
  1341.  * Read in an identifier expressions.
  1342.  * This is a symbol name followed by parenthesis, or by square brackets or
  1343.  * element refernces.  The symbol can be a global or a local variable name.
  1344.  * Returns the type of expression found.
  1345.  */
  1346. static int
  1347. getidexpr(okmat, autodef)
  1348.     BOOL okmat, autodef;
  1349. {
  1350.     int type;
  1351.     char name[SYMBOLSIZE+1];    /* symbol name */
  1352.  
  1353.     type = 0;
  1354.     if (!getid(name))
  1355.         return type;
  1356.     switch (gettoken()) {
  1357.         case T_LEFTPAREN:
  1358.             getcallargs(name);
  1359.             type = EXPR_RVALUE;
  1360.             break;
  1361.         case T_ASSIGN:
  1362.             autodef = TRUE;
  1363.             /* fall into default case */
  1364.         default:
  1365.             rescantoken();
  1366.             checksymbol(name, autodef);
  1367.     }
  1368.     /*
  1369.      * Now collect as many element references and matrix index operations
  1370.      * as there are following the id.
  1371.      */
  1372.     for (;;) {
  1373.         switch (gettoken()) {
  1374.             case T_LEFTBRACKET:
  1375.                 rescantoken();
  1376.                 if (!okmat)
  1377.                     return type;
  1378.                 getmatargs();
  1379.                 type = 0;
  1380.                 break;
  1381.             case T_PERIOD:
  1382.                 getelement();
  1383.                 type = 0;
  1384.                 break;
  1385.             case T_LEFTPAREN:
  1386.                 scanerror(T_NULL, "Function calls not allowed as expressions");
  1387.             default:
  1388.                 rescantoken();
  1389.                 return type;
  1390.         }
  1391.     }
  1392. }
  1393.  
  1394.  
  1395. /*
  1396.  * Read in a filename for a read or write command.
  1397.  * Both quoted and unquoted filenames are handled here.
  1398.  * The name must be terminated by an end of line or semicolon.
  1399.  * Returns TRUE if the filename was successfully parsed.
  1400.  */
  1401. static BOOL
  1402. getfilename(name, msg_ok)
  1403.     char name[PATHSIZE+1];
  1404.     int msg_ok;        /* TRUE => ok to print error messages */
  1405. {
  1406.     tokenmode(TM_NEWLINES | TM_ALLSYMS);
  1407.     switch (gettoken()) {
  1408.         case T_STRING:
  1409.         case T_SYMBOL:
  1410.             break;
  1411.         default:
  1412.             if (msg_ok)
  1413.                 scanerror(T_SEMICOLON, "Filename expected");
  1414.             return FALSE;
  1415.     }
  1416.     strcpy(name, tokenstring());
  1417.     switch (gettoken()) {
  1418.         case T_SEMICOLON:
  1419.         case T_NEWLINE:
  1420.         case T_EOF:
  1421.             break;
  1422.         default:
  1423.             if (msg_ok)
  1424.                 scanerror(T_SEMICOLON, 
  1425.                     "Missing semicolon after filename");
  1426.             return FALSE;
  1427.     }
  1428.     return TRUE;
  1429. }
  1430.  
  1431.  
  1432. /*
  1433.  * Read the show command and display useful information.
  1434.  */
  1435. static void
  1436. getshowcommand()
  1437. {
  1438.     char name[SYMBOLSIZE+1];
  1439.  
  1440.     if ((gettoken() != T_SHOW) || (gettoken() != T_SYMBOL)) {
  1441.         scanerror(T_SEMICOLON, "Bad syntax for SHOW command");
  1442.         return;
  1443.     }
  1444.     strcpy(name, tokenstring());
  1445.     switch (gettoken()) {
  1446.         case T_NEWLINE:
  1447.         case T_SEMICOLON:
  1448.             break;
  1449.         default:
  1450.             scanerror(T_SEMICOLON, "Bad syntax for SHOW command");
  1451.     }
  1452.     switch ((int) stringindex("builtins\0globals\0functions\0objfuncs\0memory\0", name)) {
  1453.         case 1:
  1454.             showbuiltins();
  1455.             break;
  1456.         case 2:
  1457.             showglobals();
  1458.             break;
  1459.         case 3:
  1460.             showfunctions();
  1461.             break;
  1462.         case 4:
  1463.             showobjfuncs();
  1464.             break;
  1465.         case 5:
  1466.             mem_stats("");
  1467.             break;
  1468.         default:
  1469.             scanerror(T_NULL, "Unknown SHOW parameter \"%s\"", name);
  1470.     }
  1471. }
  1472.  
  1473.  
  1474. /*
  1475.  * Read in a set of matrix index arguments, surrounded with square brackets.
  1476.  * This also handles double square brackets for 'fast indexing'.
  1477.  */
  1478. static void
  1479. getmatargs()
  1480. {
  1481.     int dim;
  1482.  
  1483.     if (gettoken() != T_LEFTBRACKET) {
  1484.         scanerror(T_NULL, "Matrix indexing expected");
  1485.         return;
  1486.     }
  1487.     /*
  1488.      * Parse all levels of the array reference
  1489.      * Look for the 'fast index' first.
  1490.      */
  1491.     if (gettoken() == T_LEFTBRACKET) {
  1492.         (void) getassignment();
  1493.         if ((gettoken() != T_RIGHTBRACKET) ||
  1494.             (gettoken() != T_RIGHTBRACKET)) {
  1495.                 scanerror(T_NULL, "Bad fast index usage");
  1496.                 return;
  1497.         }
  1498.         addop(OP_FIADDR);
  1499.         return;
  1500.     }
  1501.     rescantoken();
  1502.     /*
  1503.      * Normal indexing with the indexes separated by commas.
  1504.      */
  1505.     dim = 1;
  1506.     for (;;) {
  1507.         (void) getassignment();
  1508.         switch (gettoken()) {
  1509.             case T_RIGHTBRACKET:
  1510.                 if (gettoken() != T_LEFTBRACKET) {
  1511.                     rescantoken();
  1512.                     addopindex(OP_INDEXADDR, (long) dim);
  1513.                     return;
  1514.                 }
  1515.                 /* proceed into comma case */
  1516.                 /*FALLTHRU*/
  1517.             case T_COMMA:
  1518.                 if (++dim > MAXDIM)
  1519.                     scanerror(T_NULL, "Too many dimensions for array reference");
  1520.                 break;
  1521.             default:
  1522.                 rescantoken();
  1523.                 scanerror(T_NULL, "Missing right bracket in array reference");
  1524.                 return;
  1525.         }
  1526.     }
  1527. }
  1528.  
  1529.  
  1530. /*
  1531.  * Get an element of an object reference.
  1532.  * The leading period which introduces the element has already been read.
  1533.  */
  1534. static void
  1535. getelement()
  1536. {
  1537.     long index;
  1538.     char name[SYMBOLSIZE+1];
  1539.  
  1540.     if (!getid(name))
  1541.         return;
  1542.     index = findelement(name);
  1543.     if (index < 0) {
  1544.         scanerror(T_NULL, "Element \"%s\" is undefined", name);
  1545.         return;
  1546.     }
  1547.     addopindex(OP_ELEMADDR, index);
  1548. }
  1549.  
  1550.  
  1551. /*
  1552.  * Read in a single symbol name and copy its value into the given buffer.
  1553.  * Returns TRUE if a valid symbol id was found.
  1554.  */
  1555. static BOOL
  1556. getid(buf)
  1557.     char buf[SYMBOLSIZE+1];
  1558. {
  1559.     int type;
  1560.  
  1561.     type = gettoken();
  1562.     if (iskeyword(type)) {
  1563.         scanerror(T_NULL, "Reserved keyword used as symbol name");
  1564.         type = T_SYMBOL;
  1565.     }
  1566.     if (type != T_SYMBOL) {
  1567.         rescantoken();
  1568.         scanerror(T_NULL, "Symbol name expected");
  1569.         *buf = '\0';
  1570.         return FALSE;
  1571.     }
  1572.     strncpy(buf, tokenstring(), SYMBOLSIZE);
  1573.     buf[SYMBOLSIZE] = '\0';
  1574.     return TRUE;
  1575. }
  1576.  
  1577.  
  1578. /*
  1579.  * Check a symbol name to see if it is known and generate code to reference it.
  1580.  * The symbol can be either a parameter name, a local name, or a global name.
  1581.  * If autodef is true, we automatically define the name as a global symbol
  1582.  * if it is not yet known.
  1583.  */
  1584. static void
  1585. checksymbol(name, autodef)
  1586.     char *name;        /* symbol name to be checked */
  1587.     BOOL autodef;
  1588. {
  1589.     switch (symboltype(name)) {
  1590.         case SYM_LOCAL:
  1591.             addopindex(OP_LOCALADDR, (long) findlocal(name));
  1592.             return;
  1593.         case SYM_PARAM:
  1594.             addopindex(OP_PARAMADDR, (long) findparam(name));
  1595.             return;
  1596.         case SYM_GLOBAL:
  1597.             addopptr(OP_GLOBALADDR, (char *) findglobal(name));
  1598.             return;
  1599.     }
  1600.     /*
  1601.      * The symbol is not yet defined.
  1602.      * If we are at the top level and we are allowed to, then define it.
  1603.      */
  1604.     if ((curfunc->f_name[0] != '*') || !autodef) {
  1605.         scanerror(T_NULL, "\"%s\" is undefined", name);
  1606.         return;
  1607.     }
  1608.     (void) addglobal(name);
  1609.     addopptr(OP_GLOBALADDR, (char *) findglobal(name));
  1610. }
  1611.  
  1612.  
  1613. /*
  1614.  * Get arguments for a function call.
  1615.  * The name and beginning parenthesis has already been seen.
  1616.  * callargs = [ [ '&' ] assignment  [',' [ '&' ] assignment] ] ')'.
  1617.  */
  1618. static void
  1619. getcallargs(name)
  1620.     char *name;        /* name of function */
  1621. {
  1622.     long index;        /* function index */
  1623.     long op;        /* opcode to add */
  1624.     int argcount;        /* number of arguments */
  1625.     BOOL addrflag;
  1626.  
  1627.     op = OP_CALL;
  1628.     index = getbuiltinfunc(name);
  1629.     if (index < 0) {
  1630.         op = OP_USERCALL;
  1631.         index = adduserfunc(name);
  1632.     }
  1633.     if (gettoken() == T_RIGHTPAREN) {
  1634.         if (op == OP_CALL)
  1635.             builtincheck(index, 0);
  1636.         addopfunction(op, index, 0);
  1637.         return;
  1638.     }
  1639.     rescantoken();
  1640.     argcount = 0;
  1641.     for (;;) {
  1642.         argcount++;
  1643.         addrflag = (gettoken() == T_AND);
  1644.         if (!addrflag)
  1645.             rescantoken();
  1646.         if (!islvalue(getassignment()) && addrflag)
  1647.             scanerror(T_NULL, "Taking address of non-variable");
  1648.         if (!addrflag && (op != OP_CALL))
  1649.             addop(OP_GETVALUE);
  1650.         switch (gettoken()) {
  1651.             case T_RIGHTPAREN:
  1652.                 if (op == OP_CALL)
  1653.                     builtincheck(index, argcount);
  1654.                 addopfunction(op, index, argcount);
  1655.                 return;
  1656.             case T_COMMA:
  1657.                 break;
  1658.             default:
  1659.                 scanerror(T_SEMICOLON, "Missing right parenthesis in function call");
  1660.                 return;
  1661.         }
  1662.     }
  1663. }
  1664.  
  1665. /* END CODE */
  1666.