home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 564a.lha / igensurf_v1.0 / src.LZH / src / calexpr.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-09-28  |  19.3 KB  |  895 lines
  1. /* :ts=8 */
  2. /* Copyright (c) 1986 Regents of the University of California */
  3.  
  4. #include  <stdio.h>
  5.  
  6. #include  <ctype.h>
  7.  
  8. #include  <errno.h>
  9.  
  10. #include  "calcomp.h"
  11. #include  "calc.h"
  12.  
  13. #define ABS(x) (((x) > 0.0) ? (x) : (-(x)))
  14.  
  15. #define  Max_Line_Length    256        /* maximum line length */
  16. #define  Max_Word_Length    64        /* maximum word length */
  17.  
  18. #define  New_Node()    (Expression_T *)Ecalloc(1, sizeof(Expression_T))
  19.  
  20. #define  isid(c)    (isalnum(c) || (c) == '_' || (c) == '.')
  21.  
  22. #define  isdecimal(c)    (isdigit(c) || (c) == '.')
  23.  
  24. extern double  atof(), pow();
  25. extern char  *fgets(), *savestr();
  26. extern char  *Emalloc(), *Ecalloc();
  27. extern Expression_T  *Current_Function;
  28. extern double  EFunc_Function(), EFunc_Variable();
  29. static double  EFunc_UMinus(), EFunc_Argument(), EFunc_Number();
  30. static double  EFunc_Add(), EFunc_Subtract(), EFunc_Mult();
  31. static double  EFunc_Division(), EFunc_Power();
  32. static double  EFunc_Error();
  33. extern int  errno;
  34.  
  35. int  Next_Char;                /* lookahead character */
  36.  
  37. double  (*Expr_Funcs[])() = {        /* expression operations */
  38.     EFunc_Error,
  39.     EFunc_Variable,
  40.     EFunc_Number,
  41.     EFunc_UMinus,
  42.     EFunc_Error,
  43.     EFunc_Function,
  44.     EFunc_Argument,
  45.     EFunc_Error,
  46.     EFunc_Error,
  47.     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  48.     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  49.     EFunc_Mult,
  50.     EFunc_Add,
  51.     0,
  52.     EFunc_Subtract,
  53.     0,
  54.     EFunc_Division,
  55.     0,0,0,0,0,0,0,0,0,0,
  56.     EFunc_Error,
  57.     0,0,
  58.     EFunc_Error,
  59.     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  60.     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  61.     EFunc_Power,
  62. };
  63.  
  64. static FILE  *In_Stream;            /* input file pointer */
  65. static char  *In_Buffer;            /* line buffer */
  66. static char  *In_File;                /* input file name */
  67. static int   In_Line_No;            /* input line number */
  68. static int   In_Buffer_Pos;            /* position in buffer */
  69.  
  70.  
  71. Expression_T *Expr_Parse(expr)
  72. char  *expr;
  73. /************************************************************************/
  74. /*                                    */
  75. /* parse an expression string                         */
  76. /*                                    */
  77. /************************************************************************/
  78. {
  79.     Expression_T  *Expr;
  80.  
  81.     Init_Str(expr, NULL, 0);
  82.     Current_Function = NULL;
  83.     Expr = Get_E1();
  84.     if (Next_Char != EOF) Syntax_Error("unexpected character");
  85.     return(Expr);
  86. } /* Expr_Parse */
  87.  
  88.  
  89. double String_Eval(expr)
  90. char  *expr;
  91. /************************************************************************/
  92. /*                                    */
  93. /* evaluate an expression string                     */
  94. /*                                    */
  95. /************************************************************************/
  96. {
  97.     register Expression_T  *Expr;
  98.     double  rval;
  99.  
  100.     Expr = Expr_Parse(expr);
  101.     rval = Expr_Value(Expr);
  102.     Expr_Free(Expr);
  103.     return(rval);
  104. } /* String_Eval */
  105.  
  106.  
  107. void Expr_Free(epar)            
  108. register Expression_T  *epar;
  109. /************************************************************************/
  110. /*                                    */
  111. /* free a parse tree                             */
  112. /*                                    */
  113. /************************************************************************/
  114. {
  115.     register Expression_T  *Expr;
  116.  
  117.     switch (epar->Node_Type) {
  118.  
  119.     case ET_Variable:
  120.         Var_Free(epar->Value.Variable);
  121.         break;
  122.         
  123.     case ET_Symbol:
  124.         freestr(epar->Value.Name);
  125.         break;
  126.  
  127.     case ET_Number:
  128.     case ET_Chan:
  129.     case ET_Argument:
  130.     case ET_Timestamp:
  131.         break;
  132.  
  133.     default:
  134.         for (Expr = epar->Value.Kid; Expr != NULL; Expr = Expr->Sibling)
  135.         Expr_Free(Expr);
  136.         break;
  137.  
  138.     }
  139.  
  140.     Efree((char *)epar);
  141.  
  142. } /* Expr_Free */
  143.  
  144. static double EFunc_Argument(Expr)
  145. Expression_T  *Expr;
  146. /************************************************************************/
  147. /*                                    */
  148. /*                                    */
  149. /************************************************************************/
  150. {
  151.     return(Get_Argument(Expr->Value.Channel));
  152. }
  153.  
  154. static double EFunc_Number(Expr)
  155. Expression_T  *Expr;
  156. /************************************************************************/
  157. /*                                    */
  158. /*                                    */
  159. /************************************************************************/
  160. {
  161.     return(Expr->Value.Number);
  162. }
  163.  
  164. static double EFunc_UMinus(Expr)
  165. Expression_T  *Expr;
  166. /************************************************************************/
  167. /*                                    */
  168. /*                                    */
  169. /************************************************************************/
  170. {
  171.     register Expression_T  *Expr1 = Expr->Value.Kid;
  172.  
  173.     return(-Expr_Value(Expr1));
  174. }
  175.  
  176. static double EFunc_Add(Expr)
  177. Expression_T  *Expr;
  178. /************************************************************************/
  179. /*                                    */
  180. /*                                    */
  181. /************************************************************************/
  182. {
  183.     register Expression_T  *Expr1 = Expr->Value.Kid;
  184.  
  185.     return(Expr_Value(Expr1) + Expr_Value(Expr1->Sibling));
  186. }
  187.  
  188. static double EFunc_Subtract(Expr)
  189. Expression_T  *Expr;
  190. /************************************************************************/
  191. /*                                    */
  192. /*                                    */
  193. /************************************************************************/
  194. {
  195.     register Expression_T  *Expr1 = Expr->Value.Kid;
  196.  
  197.     return(Expr_Value(Expr1) - Expr_Value(Expr1->Sibling));
  198. }
  199.  
  200. static double EFunc_Mult(Expr)
  201. Expression_T  *Expr;
  202. /************************************************************************/
  203. /*                                    */
  204. /*                                    */
  205. /************************************************************************/
  206. {
  207.     register Expression_T  *Expr1 = Expr->Value.Kid;
  208.  
  209.     return(Expr_Value(Expr1) * Expr_Value(Expr1->Sibling));
  210. }
  211.  
  212. static double EFunc_Division(Expr)
  213. Expression_T  *Expr;
  214. /************************************************************************/
  215. /*                                    */
  216. /*                                    */
  217. /************************************************************************/
  218. {
  219.     register Expression_T  *Expr1 = Expr->Value.Kid;
  220.     double  d;
  221.  
  222.     d = Expr_Value(Expr1->Sibling);
  223.     if (d == 0.0) {
  224.     fprintf(stderr, "Division by zero\n");
  225.     errno = ERANGE;
  226.     return(0.0);
  227.     }
  228.     return(Expr_Value(Expr1) / d);
  229. }
  230.  
  231. static double EFunc_Power(Expr)
  232. Expression_T  *Expr;
  233. /************************************************************************/
  234. /*                                    */
  235. /*                                    */
  236. /************************************************************************/
  237. {
  238.     register Expression_T  *Expr1 = Expr->Value.Kid;
  239.     double             d, dtmp;
  240.     int             lasterrno;
  241.  
  242.     lasterrno = errno;
  243.     errno     = 0;
  244.     dtmp      = Expr_Value(Expr1);
  245.  
  246.     if (ABS(dtmp) < 1e-5) d = 0.0;
  247.     else           d = pow(dtmp, Expr_Value(Expr1->Sibling));
  248.  
  249.     /* d = pow(Expr_Value(Expr1), Expr_Value(Expr1->Sibling)); */
  250.  
  251. #ifdef  IEEE
  252.     if (!finite(d)) errno = EDOM;
  253. #endif
  254.  
  255.     if (errno) {
  256.  
  257.     fprintf(stderr, "Illegal power\n");
  258.     return(0.0);
  259.  
  260.     } /* if */
  261.  
  262.     errno = lasterrno;
  263.     return(d);
  264.  
  265. } /* EFunc_Power */
  266.  
  267. static double EFunc_Error(Expr)
  268. Expression_T  *Expr;
  269. /************************************************************************/
  270. /*                                    */
  271. /*                                    */
  272. /************************************************************************/
  273. {
  274.     fprintf(stderr, "Bad expression!\n");
  275.     exit(1);
  276.     return(0.0);    /* Dummy return to remove warning msg at compile */
  277. }
  278.  
  279.  
  280. Expression_T *Expr_Kid(Expr, n)    
  281. register Expression_T  *Expr;
  282. register int  n;
  283. /************************************************************************/
  284. /*                                    */
  285. /* return pointer to a node's nth kid                     */
  286. /*                                    */
  287. /************************************************************************/
  288. {
  289.  
  290.     for (Expr = Expr->Value.Kid; Expr != NULL; Expr = Expr->Sibling)
  291.     if (--n < 0)
  292.         break;
  293.  
  294.     return(Expr);
  295.  
  296. } /* Expr_Kid */
  297.  
  298.  
  299. int Nbr_Kids(Expr)
  300. register Expression_T  *Expr;
  301. /************************************************************************/
  302. /*                                    */
  303. /* return # of kids for node Expr                     */
  304. /*                                    */
  305. /************************************************************************/
  306. {
  307.     register int  n = 0;
  308.  
  309.     for (Expr = Expr->Value.Kid; Expr != NULL; Expr = Expr->Sibling)
  310.     n++;
  311.  
  312.     return(n);
  313. } /* Nbr_Kids */
  314.  
  315.  
  316. void Init_File(fp, fn, ln)
  317. FILE  *fp;
  318. char  *fn;
  319. int  ln;
  320. /************************************************************************/
  321. /*                                    */
  322. /* prepare input file                             */
  323. /*                                    */
  324. /************************************************************************/
  325. {
  326.     static char  inpbuf[Max_Line_Length+1];
  327.  
  328.     In_Stream = fp;
  329.     In_Buffer = inpbuf;
  330.     In_File = fn;
  331.     In_Line_No = ln;
  332.     In_Buffer_Pos = 0;
  333.     inpbuf[0] = '\0';
  334.     Get_Next_Char();
  335. } /* Init_File */
  336.  
  337.  
  338. void Init_Str(s, fn, ln)
  339. char  *s;
  340. char  *fn;
  341. int  ln;
  342. /************************************************************************/
  343. /*                                    */
  344. /* prepare input string                         */
  345. /*                                    */
  346. /************************************************************************/
  347. {
  348.     In_Stream = NULL;
  349.     In_File = fn;
  350.     In_Line_No = ln;
  351.     In_Buffer = s;
  352.     In_Buffer_Pos = 0;
  353.     Get_Next_Char();
  354. } /* Init_Str */
  355.  
  356.  
  357. void Get_Next_Char()
  358. /************************************************************************/
  359. /*                                    */
  360. /* scan next character                             */
  361. /*                                    */
  362. /************************************************************************/
  363. {
  364.     extern int   (*Command_Func)();
  365.     int       Status;
  366.  
  367.     do {
  368.  
  369.     if (In_Buffer[In_Buffer_Pos] == '\0') {
  370.  
  371.         if (In_Stream == NULL || 
  372.             fgets(In_Buffer, Max_Line_Length, In_Stream) == NULL) {
  373.  
  374.         Next_Char = EOF;
  375.  
  376.         } else {
  377.  
  378.         In_Line_No++;
  379.  
  380.         if (In_Buffer[0] == '#') {
  381.  
  382.             if (Command_Func != NULL) {
  383.                 Status = Command_Func(In_Buffer, In_Line_No);
  384.             if (Status != 0) Next_Char = EOF;
  385.             }
  386.             In_Buffer[0] = '\n'; In_Buffer[1] = '\0';
  387.  
  388.         } /* if */
  389.  
  390.         Next_Char = In_Buffer[0];
  391.         In_Buffer_Pos = 1;
  392.  
  393.         }
  394.  
  395.     } else Next_Char = In_Buffer[In_Buffer_Pos++];
  396.  
  397.     if (Next_Char == '{') {            /* A comment    */
  398.  
  399.         Get_Next_Char();
  400.  
  401.         while (Next_Char != '}') {
  402.  
  403.         if (Next_Char == EOF) Syntax_Error("'}' expected");
  404.         else               Get_Next_Char();
  405.  
  406.         } /* while */
  407.  
  408.         Get_Next_Char();
  409.  
  410.     } /* if */
  411.  
  412.     } while (isspace(Next_Char));
  413.  
  414. } /* Get_Next_Char */
  415.  
  416.  
  417. void Syntax_Error(Msg)
  418. char  *Msg;
  419. /************************************************************************/
  420. /*                                    */
  421. /* report syntax error and quit                     */
  422. /*                                    */
  423. /************************************************************************/
  424. {
  425.     register int  i;
  426.  
  427.     if (In_File != NULL || In_Line_No != 0) {
  428.  
  429.     if (In_File != NULL) fprintf(stderr, In_File);
  430.     if (In_Line_No != 0) {
  431.         fprintf(stderr, In_File != NULL ? ", line " : "line ");
  432.         fprintf(stderr, "%ld", (long)In_Line_No);
  433.     }
  434.     fprintf(stderr, ": syntax error:\n");
  435.     }
  436.  
  437.     fprintf(stderr, In_Buffer);
  438.     if (In_Buffer[strlen(In_Buffer)-1] != '\n') fprintf(stderr, "\n");
  439.     for (i = 0; i < In_Buffer_Pos-1; i++)
  440.     fprintf(stderr, In_Buffer[i] == '\t' ? "\t" : " ");
  441.     fprintf(stderr, "^ ");
  442.     fprintf(stderr, Msg);
  443.     fprintf(stderr, "\n");
  444.     exit(1);
  445. } /* Syntax_Error */
  446.  
  447.  
  448. void Add_Kid(Expr, Kid)
  449. register Expression_T  *Expr;
  450. Expression_T  *Kid;
  451. /************************************************************************/
  452. /*                                    */
  453. /* add a child to Expr                             */
  454. /*                                    */
  455. /************************************************************************/
  456. {
  457.     if (Expr->Value.Kid == NULL) Expr->Value.Kid = Kid;
  458.     else {
  459.  
  460.     for (Expr = Expr->Value.Kid; 
  461.             Expr->Sibling != NULL; Expr = Expr->Sibling) ;
  462.     Expr->Sibling = Kid;
  463.  
  464.     }
  465.  
  466.     Kid->Sibling = NULL;
  467.  
  468. } /* Add_Kid */
  469.  
  470.  
  471. char *Get_Name()    
  472. /************************************************************************/
  473. /*                                    */
  474. /* scan an identifier                             */
  475. /*                                    */
  476. /************************************************************************/
  477. {
  478.     static char  str[Max_Word_Length+1];
  479.     register int  i;
  480.  
  481.     for (i = 0; i < Max_Word_Length && 
  482.                 isid(Next_Char); i++, Get_Next_Char()) str[i] = Next_Char;
  483.  
  484.     str[i] = '\0';
  485.  
  486.     return(str);
  487.  
  488. } /* Get_Name */
  489.  
  490.  
  491. int GetInteger()
  492. /************************************************************************/
  493. /*                                    */
  494. /* scan a positive integer                         */
  495. /*                                    */
  496. /************************************************************************/
  497. {
  498.     register int  n;
  499.  
  500.     n = 0;
  501.     while (isdigit(Next_Char)) {
  502.     n = n * 10 + Next_Char - '0';
  503.     Get_Next_Char();
  504.     }
  505.     return(n);
  506. } /* GetInteger */
  507.  
  508.  
  509. double GetFloat()
  510. /************************************************************************/
  511. /*                                    */
  512. /* scan a positive float                         */
  513. /*                                    */
  514. /************************************************************************/
  515. {
  516.     register int  i;
  517.     char  str[Max_Word_Length+1];
  518.  
  519.     i = 0;
  520.  
  521.     while (isdigit(Next_Char) && i < Max_Word_Length) {
  522.  
  523.     str[i++] = Next_Char;
  524.     Get_Next_Char();
  525.  
  526.     } /* while */
  527.  
  528.     if (Next_Char == '.' && i < Max_Word_Length) {
  529.  
  530.         str[i++] = Next_Char;
  531.         Get_Next_Char();
  532.  
  533.     while (isdigit(Next_Char) && i < Max_Word_Length) {
  534.  
  535.         str[i++] = Next_Char;
  536.         Get_Next_Char();
  537.  
  538.     } /* while */
  539.  
  540.     } /* if */
  541.  
  542.     if ((Next_Char == 'e' || Next_Char == 'E') && i < Max_Word_Length) {
  543.  
  544.         str[i++] = Next_Char;
  545.         Get_Next_Char();
  546.  
  547.     if ((Next_Char == '-' || Next_Char == '+') && i < Max_Word_Length) {
  548.  
  549.         str[i++] = Next_Char;
  550.         Get_Next_Char();
  551.  
  552.     } /* if */
  553.  
  554.  
  555.     while (isdigit(Next_Char) && i < Max_Word_Length) {
  556.  
  557.         str[i++] = Next_Char;
  558.         Get_Next_Char();
  559.  
  560.     } /* while */
  561.  
  562.     } /* if */
  563.  
  564.     str[i] = '\0';
  565.  
  566.     return(atof(str));
  567.  
  568. } /* GetFloat */
  569.  
  570.  
  571. Expression_T *Get_E1()
  572. /************************************************************************/
  573. /*                                    */
  574. /* E1 -> E1 ADDOP E2                             */
  575. /*       E2                                 */
  576. /*                                    */
  577. /************************************************************************/
  578. {
  579.     register Expression_T  *Expr1, *Expr2;
  580.  
  581.     Expr1 = Get_E2();
  582.     while (Next_Char == '+' || Next_Char == '-') {
  583.     Expr2 = New_Node();
  584.     Expr2->Node_Type = Next_Char;
  585.     Get_Next_Char();
  586.     Add_Kid(Expr2, Expr1);
  587.     Add_Kid(Expr2, Get_E2());
  588.     if (Expr1->Node_Type == ET_Number && 
  589.         Expr1->Sibling->Node_Type == ET_Number)
  590.                     Expr2 = Const_Reduce(Expr2);
  591.     Expr1 = Expr2;
  592.     }
  593.     return(Expr1);
  594.  
  595. } /* Get_E1 */
  596.  
  597.  
  598. Expression_T *Get_E2()    
  599. /************************************************************************/
  600. /*                                    */
  601. /* E2 -> E2 MULOP E3                             */
  602. /*       E3                                 */
  603. /*                                    */
  604. /************************************************************************/
  605. {
  606.     register Expression_T  *Expr1, *Expr2;
  607.  
  608.     Expr1 = Get_E3();
  609.  
  610.     while (Next_Char == '*' || Next_Char == '/') {
  611.  
  612.     Expr2 = New_Node();
  613.     Expr2->Node_Type = Next_Char;
  614.  
  615.     Get_Next_Char();
  616.  
  617.     Add_Kid(Expr2, Expr1);
  618.     Add_Kid(Expr2, Get_E3());
  619.  
  620.     if (Expr1->Node_Type == ET_Number && 
  621.         Expr1->Sibling->Node_Type == ET_Number) 
  622.                         Expr2 = Const_Reduce(Expr2);
  623.  
  624.     Expr1 = Expr2;
  625.  
  626.     } /* while */
  627.  
  628.     return(Expr1);
  629.  
  630. } /* Get_E2 */
  631.  
  632.  
  633. Expression_T *Get_E3()
  634. /************************************************************************/
  635. /*                                    */
  636. /* E3 -> E4 ^ E3                             */
  637. /*       E4                                 */
  638. /*                                    */
  639. /************************************************************************/
  640. {
  641.     register Expression_T  *Expr1, *Expr2;
  642.  
  643.     Expr1 = Get_E4();
  644.  
  645.     if (Next_Char == '^') {
  646.  
  647.     Expr2 = New_Node();
  648.     Expr2->Node_Type = Next_Char;
  649.  
  650.     Get_Next_Char();
  651.  
  652.     Add_Kid(Expr2, Expr1);
  653.     Add_Kid(Expr2, Get_E3());
  654.  
  655.     if (Expr1->Node_Type == ET_Number && 
  656.         Expr1->Sibling->Node_Type == ET_Number) 
  657.                         Expr2 = Const_Reduce(Expr2);
  658.  
  659.     return(Expr2);
  660.  
  661.     } /* if */
  662.  
  663.     return(Expr1);
  664.  
  665. } /* Get_E3 */
  666.  
  667.  
  668. Expression_T * Get_E4()
  669. /************************************************************************/
  670. /*                                    */
  671. /* E4 -> ADDOP E5                             */
  672. /*       E5                                 */
  673. /*                                    */
  674. /************************************************************************/
  675. {
  676.     register Expression_T  *Expr1, *Expr2;
  677.  
  678.     if (Next_Char == '-') {
  679.  
  680.     Get_Next_Char();
  681.  
  682.     Expr2 = Get_E5();
  683.  
  684.     if (Expr2->Node_Type == ET_Number) {
  685.  
  686.         Expr2->Value.Number = -Expr2->Value.Number;
  687.         return(Expr2);
  688.  
  689.     } /* if */
  690.  
  691.     Expr1 = New_Node();
  692.     Expr1->Node_Type = ET_UMinus;
  693.  
  694.     Add_Kid(Expr1, Expr2);
  695.  
  696.     return(Expr1);
  697.  
  698.     } /* if */
  699.  
  700.     if (Next_Char == '+') Get_Next_Char();
  701.  
  702.     return(Get_E5());
  703.  
  704. } /* Get_E4 */
  705.  
  706.  
  707. Expression_T *Get_E5()
  708. /************************************************************************/
  709. /*                                    */
  710. /* E5 -> (E1)                                 */
  711. /*       ET_Variable                             */
  712. /*       ET_Number                             */
  713. /*       $N                                 */
  714. /*       ET_Function(E1,..)                         */
  715. /*       ET_Argument                             */
  716. /*                                    */
  717. /************************************************************************/
  718. {
  719.     int  i;
  720.     register Expression_T  *Expr1, *Expr2;
  721.  
  722.     if (Next_Char == '(') {
  723.  
  724.     Get_Next_Char();
  725.  
  726.     Expr1 = Get_E1();
  727.  
  728.     if (Next_Char != ')') Syntax_Error("')' expected");
  729.  
  730.     Get_Next_Char();
  731.  
  732.     return(Expr1);
  733.  
  734.     } /* if */
  735.  
  736.     if (isalpha(Next_Char)) {
  737.  
  738.      Expr1 = New_Node(); 
  739.     Expr1->Node_Type = ET_Variable; 
  740.  
  741.         Expr1->Value.Variable = Var_Insert(Get_Name());
  742.  
  743.     if (Current_Function != NULL) {
  744.  
  745.         for (i = 1, Expr2 = Current_Function->Value.Kid->Sibling;
  746.                     Expr2 != NULL; i++, Expr2 = Expr2->Sibling) {
  747.  
  748.         if (!strcmp(Expr2->Value.Name,Expr1->Value.Variable->Name)) {
  749.  
  750.             Expr_Free(Expr1);
  751.  
  752.             Expr1 = New_Node();
  753.             Expr1->Node_Type = ET_Argument;
  754.             Expr1->Value.Channel = i;
  755.  
  756.             break;
  757.  
  758.         } /* if */
  759.  
  760.         } /* while */
  761.  
  762.     } /* if */
  763.  
  764.     if (Next_Char == '(') {
  765.  
  766.         Expr2 = New_Node();
  767.         Expr2->Node_Type = ET_Function;
  768.  
  769.         Add_Kid(Expr2, Expr1);
  770.  
  771.         Expr1 = Expr2;
  772.  
  773.         do {
  774.  
  775.         Get_Next_Char();
  776.         Add_Kid(Expr1, Get_E1());
  777.  
  778.         } while (Next_Char == ',');
  779.  
  780.         if (Next_Char != ')') Syntax_Error("')' expected");
  781.  
  782.         Get_Next_Char();
  783.  
  784.     } /* if */
  785.         
  786.     if (Is_Const_Var(Expr1)) Expr1 = Const_Reduce(Expr1);
  787.  
  788.     return(Expr1);
  789.  
  790.     } /* if */
  791.  
  792.     if (isdecimal(Next_Char)) {
  793.  
  794.     Expr1 = New_Node();
  795.     Expr1->Node_Type = ET_Number;
  796.     Expr1->Value.Number = GetFloat();
  797.  
  798.     return(Expr1);
  799.  
  800.     } /* if */
  801.  
  802.     Syntax_Error("unexpected character");
  803.  
  804. } /* Get_E5 */
  805.  
  806.  
  807. Expression_T *Const_Reduce(epar)            
  808. register Expression_T  *epar;
  809. /************************************************************************/
  810. /*                                    */
  811. /* reduce a constant expression                     */
  812. /*                                    */
  813. /************************************************************************/
  814. {
  815.     register Expression_T  *Expr;
  816.  
  817.     Expr = New_Node();
  818.     Expr->Node_Type = ET_Number;
  819.  
  820.     errno = 0;
  821.  
  822.     Expr->Value.Number = Expr_Value(epar);
  823.  
  824.     if (errno) Syntax_Error("bad constant expression");
  825.  
  826.     Expr_Free(epar);
  827.  
  828.     return(Expr);
  829.  
  830. } /* Const_Reduce */
  831.  
  832.  
  833. int Is_Const_Var(Expr)
  834. register Expression_T  *Expr;
  835. /************************************************************************/
  836. /*                                    */
  837. /* is Expr linked to a constant expression?                 */
  838. /*                                    */
  839. /************************************************************************/
  840. {
  841.     register Expression_T  *Expr1;
  842.  
  843.     if (Expr->Node_Type == ET_Function) {
  844.  
  845.     if (!Is_Const_Fun(Expr->Value.Kid)) return(0);
  846.  
  847.     for (Expr1 = Expr->Value.Kid->Sibling; 
  848.             Expr1 != NULL; Expr1 = Expr1->Sibling) {
  849.  
  850.         if (Expr1->Node_Type != ET_Number && !Is_Const_Fun(Expr1)) 
  851.                                     return(0);
  852.  
  853.     } /* for */
  854.  
  855.     return(1);
  856.  
  857.     } /* if */
  858.  
  859.     if (Expr->Node_Type != ET_Variable) return(0);
  860.  
  861.     Expr1 = Expr->Value.Variable->Expression;
  862.  
  863.     if (Expr1 == NULL || Expr1->Node_Type != ':') return(0);
  864.  
  865.     if (Expr1->Value.Kid->Node_Type != ET_Symbol) return(0);
  866.  
  867.     return(1);
  868.  
  869. } /* Is_Const_Var */
  870.  
  871.  
  872. int Is_Const_Fun(Expr)
  873. register Expression_T  *Expr;
  874. /************************************************************************/
  875. /*                                    */
  876. /* is Expr linked to a constant function?                 */
  877. /*                                    */
  878. /************************************************************************/
  879. {
  880.     register Expression_T  *dp;
  881.     register Function_T  *lp;
  882.  
  883.     if (Expr->Node_Type != ET_Variable) return(0);
  884.  
  885.     dp = Expr->Value.Variable->Expression;
  886.  
  887.     if (dp != NULL && dp->Node_Type != ':') return(0);
  888.  
  889.     if ((dp == NULL || dp->Value.Kid->Node_Type != ET_Function)
  890.         && ((lp = LibFunc_Lookup(Expr->Value.Variable->Name)) == NULL
  891.             || lp->Assignment_Type != ':')) return(0);
  892.  
  893.     return(1);
  894. } /* Is_Const_Fun */
  895.