1 /***************************************************************************
2 JSPICE3 adaptation of Spice3e2 - Copyright (c) Stephen R. Whiteley 1992
3 Copyright 1990 Regents of the University of California. All rights reserved.
4 Authors: 1985 Wayne A. Christopher
5 1992 Stephen R. Whiteley
6 ****************************************************************************/
7
8 /*
9 * A simple operator-precedence parser for algebraic expressions.
10 * This also handles relational and logical expressions.
11 */
12
13 #include "spice.h"
14 #include "ftedefs.h"
15 #include "ftecmath.h"
16
17 #ifdef __STDC__
18 static bool checkvalid(struct pnode*);
19 static struct element *lexer(void);
20 static struct pnode *parse(void);
21 static struct pnode *makepnode(struct element*);
22 static struct pnode *mkbnode(int,struct pnode*,struct pnode*);
23 static struct pnode *mkunode(int,struct pnode*);
24 static struct pnode *mkfnode(char*,struct pnode*);
25 static struct pnode *mknnode(double);
26 static struct pnode *mksnode(char*);
27 #else
28 static bool checkvalid();
29 static struct element *lexer();
30 static struct pnode *parse();
31 static struct pnode *makepnode();
32 static struct pnode *mkbnode();
33 static struct pnode *mkunode();
34 static struct pnode *mkfnode();
35 static struct pnode *mknnode();
36 static struct pnode *mksnode();
37 #endif
38
39 static int lasttoken = END, lasttype;
40 static char *sbuf;
41
42
43 struct pnode *
ft_getpnames(wl,check)44 ft_getpnames(wl, check)
45
46 wordlist *wl;
47 bool check;
48 {
49 struct pnode *pn = NULL, *lpn = NULL, *p;
50 char *xsbuf;
51 char buf[BSIZE_SP], *thisone, *s;
52
53 if (!wl) {
54 fprintf(cp_err, "Warning: NULL arithmetic expression\n");
55 return (NULL);
56 }
57
58 lasttoken = END;
59 xsbuf = sbuf = wl_flatten(wl);
60 thisone = sbuf;
61 while (*sbuf != '\0') {
62 if (!(p = parse())) {
63 fprintf(cp_err,"%s\n",xsbuf);
64 tfree(xsbuf);
65 return (NULL);
66 }
67
68 /* Now snag the name... Much trouble... */
69 while (isspace(*thisone))
70 thisone++;
71 for (s = buf; thisone < sbuf; s++, thisone++)
72 *s = *thisone;
73 do {s--;}
74 while (isspace(*s) && s != buf);
75 *(s+1) = '\0';
76 /* delete second - in unary coersion */
77 s = buf;
78 if (*s == '-' && *(s+1) == '-')
79 s++;
80 p->pn_name = copy(s);
81
82 if (pn) {
83 lpn->pn_next = p;
84 lpn = p;
85 }
86 else
87 pn = lpn = p;
88 }
89 txfree(xsbuf);
90 if (check)
91 if (!checkvalid(pn))
92 return (NULL);
93 return (pn);
94 }
95
96
97 /* See if there are any variables around which have length 0 and are
98 * not named 'list'. There should really be another flag for this...
99 */
100
101 static bool
checkvalid(pn)102 checkvalid(pn)
103
104 struct pnode *pn;
105 {
106 while (pn) {
107 if (pn->pn_value) {
108 if ((pn->pn_value->v_length == 0) &&
109 !eq(pn->pn_value->v_name, "list")) {
110 if (eq(pn->pn_value->v_name, "all"))
111 fprintf(cp_err,
112 "Error: %s: no matching vectors.\n",
113 pn->pn_value->v_name);
114 else
115 fprintf(cp_err,
116 "Error: %s: no such vector.\n",
117 pn->pn_value->v_name);
118 return (false);
119 }
120 }
121 else if (pn->pn_func ||
122 (pn->pn_op && (pn->pn_op->op_arity == 1))) {
123 if (!checkvalid(pn->pn_left))
124 return (false);
125 }
126 else if (pn->pn_op && (pn->pn_op->op_arity == 2)) {
127 if (!checkvalid(pn->pn_left))
128 return (false);
129 if (!checkvalid(pn->pn_right))
130 return (false);
131 }
132 else
133 fprintf(cp_err,
134 "checkvalid: Internal Error: bad node\n");
135 pn = pn->pn_next;
136 }
137 return (true);
138 }
139
140
141 /* Everything else is a string or a number. Quoted strings are kept in
142 * the form "string", and the lexer strips off the quotes...
143 */
144
145 static struct element *
lexer()146 lexer()
147 {
148 double *td;
149 int j = 0;
150 static struct element el;
151 static struct element end = { END };
152 static char *specials = " \t%()-^+*,/|&<>~=";
153 static bool bracflag = false;
154 char *ss, *s;
155
156 if (bracflag) {
157 bracflag = false;
158 el.e_token = LPAREN;
159 goto done;
160 }
161
162 el.e_token = END;
163 while ((*sbuf == ' ') || (*sbuf == '\t'))
164 sbuf++;
165 if (*sbuf == '\0')
166 goto done;
167
168 switch (*sbuf) {
169
170 case '-':
171 if (*(sbuf+1) == '-') {
172 /* '--' forces unary - */
173 if ((lasttoken == VALUE) || (lasttoken == RPAREN)) {
174 el = end;
175 goto done;
176 }
177 sbuf += 2;
178 el.e_token = UMINUS;
179 }
180 else {
181 if ((lasttoken == VALUE) || (lasttoken == RPAREN))
182 el.e_token = MINUS;
183 else
184 el.e_token = UMINUS;
185 sbuf++;
186 }
187 break;
188
189 case '+':
190 el.e_token = PLUS;
191 sbuf++;
192 break;
193
194 case ',':
195 el.e_token = COMMA;
196 sbuf++;
197 break;
198
199 case '*':
200 el.e_token = TIMES;
201 sbuf++;
202 break;
203
204 case '%':
205 el.e_token = MOD;
206 sbuf++;
207 break;
208
209 case '/':
210 el.e_token = DIVIDE;
211 sbuf++;
212 break;
213
214 case '^':
215 el.e_token = POWER;
216 sbuf++;
217 break;
218
219 case '[':
220 if (sbuf[1] == '[') {
221 el.e_token = RANGE;
222 sbuf += 2;
223 }
224 else {
225 el.e_token = INDX;
226 sbuf++;
227 }
228 bracflag = true;
229 break;
230
231 case '(':
232 if (((lasttoken == VALUE) && ((lasttype == NUM))) || (lasttoken
233 == RPAREN)) {
234 el = end;
235 goto done;
236 }
237 else {
238 el.e_token = LPAREN;
239 sbuf++;
240 break;
241 }
242
243 case ']':
244 el.e_token = RPAREN;
245 if (sbuf[1] == ']')
246 sbuf += 2;
247 else
248 sbuf++;
249 break;
250
251 case ')':
252 el.e_token = RPAREN;
253 sbuf++;
254 break;
255
256 case '=':
257 el.e_token = EQ;
258 sbuf++;
259 break;
260
261 case '>':
262 case '<':
263 for (j = 1; isspace(sbuf[j]); j++)
264 ; /* The lexer makes <> into < > */
265 if (((sbuf[j] == '<') || (sbuf[j] == '>')) &&
266 (sbuf[0] != sbuf[j])) {
267 /* Allow both <> and >< for NE. */
268 el.e_token = NE;
269 sbuf += 2 + j;
270 }
271 else if (sbuf[1] == '=') {
272 if (sbuf[0] == '>')
273 el.e_token = GE;
274 else
275 el.e_token = LE;
276 sbuf += 2;
277 }
278 else {
279 if (sbuf[0] == '>')
280 el.e_token = GT;
281 else
282 el.e_token = LT;
283 sbuf++;
284 }
285 break;
286
287 case '&':
288 el.e_token = AND;
289 sbuf++;
290 break;
291
292 case '|':
293 el.e_token = OR;
294 sbuf++;
295 break;
296
297 case '~':
298 el.e_token = NOT;
299 sbuf++;
300 break;
301
302 case '"':
303 if ((lasttoken == VALUE) || (lasttoken == RPAREN)) {
304 el = end;
305 goto done;
306 }
307 el.e_token = VALUE;
308 el.e_type = STRING;
309 el.e_string = copy(++sbuf);
310 for (s = el.e_string; *s && (*s != '"'); s++, sbuf++)
311 ;
312 *s = '\0';
313 sbuf++;
314 break;
315 }
316
317 if (el.e_token != END)
318 goto done;
319
320 ss = sbuf;
321 td = ft_numparse(&ss, false);
322 if (td) {
323 if ((lasttoken == VALUE) || (lasttoken == RPAREN)) {
324 el = end;
325 goto done;
326 }
327 el.e_double = *td;
328 el.e_type = NUM;
329 el.e_token = VALUE;
330 sbuf = ss;
331 if (ft_parsedb)
332 fprintf(stderr, "lexer: double %G\n",
333 el.e_double);
334 }
335 else {
336 /* First, let's check for eq, ne, and so on. */
337 if ((sbuf[0] == 'g') && (sbuf[1] == 't') &&
338 strchr(specials, sbuf[2])) {
339 el.e_token = GT;
340 sbuf += 2;
341 }
342 else if ((sbuf[0] == 'l') && (sbuf[1] == 't') &&
343 strchr(specials, sbuf[2])) {
344 el.e_token = LT;
345 sbuf += 2;
346 }
347 else if ((sbuf[0] == 'g') && (sbuf[1] == 'e') &&
348 strchr(specials, sbuf[2])) {
349 el.e_token = GE;
350 sbuf += 2;
351 }
352 else if ((sbuf[0] == 'l') && (sbuf[1] == 'e') &&
353 strchr(specials, sbuf[2])) {
354 el.e_token = LE;
355 sbuf += 2;
356 }
357 else if ((sbuf[0] == 'n') && (sbuf[1] == 'e') &&
358 strchr(specials, sbuf[2])) {
359 el.e_token = NE;
360 sbuf += 2;
361 }
362 else if ((sbuf[0] == 'e') && (sbuf[1] == 'q') &&
363 strchr(specials, sbuf[2])) {
364 el.e_token = EQ;
365 sbuf += 2;
366 }
367 else if ((sbuf[0] == 'o') && (sbuf[1] == 'r') &&
368 strchr(specials, sbuf[2])) {
369 el.e_token = OR;
370 sbuf += 2;
371 }
372 else if ((sbuf[0] == 'a') && (sbuf[1] == 'n') &&
373 (sbuf[2] == 'd') && strchr(specials, sbuf[3])) {
374 el.e_token = AND;
375 sbuf += 3;
376 }
377 else if ((sbuf[0] == 'n') && (sbuf[1] == 'o') &&
378 (sbuf[2] == 't') && strchr(specials, sbuf[3])) {
379 el.e_token = NOT;
380 sbuf += 3;
381 }
382 else {
383 if ((lasttoken == VALUE) || (lasttoken == RPAREN)) {
384 el = end;
385 goto done;
386 }
387
388 /* Deal with node voltages here by making the v(...)
389 * a string, thus avoiding confusion with function
390 * calls.
391 */
392
393 el.e_string = copy(sbuf);
394
395 if (ciprefix("v(",el.e_string)) {
396 for (s = el.e_string; *s && *s != ')'; s++, sbuf++) ;
397 if (*s) {
398 s++;
399 sbuf++;
400 *s = '\0';
401 }
402 }
403 else {
404
405 /* It is bad how we have to recognise '[' -- sometimes
406 * it is part of a word, when it defines a parameter
407 * name, and otherwise it isn't.
408 */
409 for (s = el.e_string;
410 *s && !strchr(specials, *s) && *s != ']'; s++, sbuf++)
411
412 if ((*s == '[') && (*el.e_string != '@'))
413 break;
414 if (*s) {
415 if (*s != ']')
416 *s = '\0';
417 else {
418 *(++s) = '\0';
419 sbuf++;
420 }
421 }
422 }
423 el.e_type = STRING;
424 el.e_token = VALUE;
425 if (ft_parsedb)
426 fprintf(stderr, "lexer: string %s\n",
427 el.e_string);
428 }
429 }
430 done:
431 lasttoken = el.e_token;
432 lasttype = el.e_type;
433 if (ft_parsedb)
434 fprintf(stderr, "lexer: token %d\n", el.e_token);
435 return (&el);
436 }
437
438
439 /* The operator-precedence parser. */
440
441 #define G 1 /* Greater than. */
442 #define L 2 /* Less than. */
443 #define E 3 /* Equal. */
444 #define R 4 /* Error. */
445
446 #define STACKSIZE 200
447
448 static char prectable[23][23] = {
449 /* $ + - * % / ^ u- ( ) , v = > < >= <= <> & | ~ IDX R */
450 /* $ */ { R, L, L, L, L, L, L, L, L, R, L, L, L, L, L, L, L, L, L, L, L, L, L },
451 /* + */ { G, G, G, L, L, L, L, L, L, G, G, L, G, G, G, G, G, G, G, G, G, L, L },
452 /* - */ { G, G, G, L, L, L, L, L, L, G, G, L, G, G, G, G, G, G, G, G, G, L, L },
453 /* * */ { G, G, G, G, G, G, L, L, L, G, G, L, G, G, G, G, G, G, G, G, G, L, L },
454 /* % */ { G, G, G, G, G, G, L, L, L, G, G, L, G, G, G, G, G, G, G, G, G, L, L },
455 /* / */ { G, G, G, G, G, G, L, L, L, G, G, L, G, G, G, G, G, G, G, G, G, L, L },
456 /* ^ */ { G, G, G, G, G, G, L, L, L, G, G, L, G, G, G, G, G, G, G, G, G, L, L },
457 /* u-*/ { G, G, G, G, G, G, G, G, L, G, G, L, G, G, G, G, G, G, G, G, G, L, L },
458 /* ( */ { R, L, L, L, L, L, L, L, L, E, L, L, L, L, L, L, L, L, L, L, L, L, L },
459 /* ) */ { G, G, G, G, G, G, G, G, R, G, G, R, G, G, G, G, G, G, G, G, G, G, G },
460 /* , */ { G, L, L, L, L, L, L, L, L, G, L, L, G, G, G, G, G, G, G, G, G, L, L },
461 /* v */ { G, G, G, G, G, G, G, G, G, G, G, R, G, G, G, G, G, G, G, G, G, G, G },
462 /* = */ { G, L, L, L, L, L, L, L, L, G, L, L, G, G, G, G, G, G, G, G, L, L, L },
463 /* > */ { G, L, L, L, L, L, L, L, L, G, L, L, G, G, G, G, G, G, G, G, L, L, L },
464 /* < */ { G, L, L, L, L, L, L, L, L, G, L, L, G, G, G, G, G, G, G, G, L, L, L },
465 /* >=*/ { G, L, L, L, L, L, L, L, L, G, L, L, G, G, G, G, G, G, G, G, L, L, L },
466 /* <=*/ { G, L, L, L, L, L, L, L, L, G, L, L, G, G, G, G, G, G, G, G, L, L, L },
467 /* <>*/ { G, L, L, L, L, L, L, L, L, G, L, L, G, G, G, G, G, G, G, G, L, L, L },
468 /* & */ { G, L, L, L, L, L, L, L, L, G, L, L, L, L, L, L, L, L, G, G, L, L, L },
469 /* | */ { G, L, L, L, L, L, L, L, L, G, L, L, L, L, L, L, L, L, L, G, L, L, L },
470 /* ~ */ { G, L, L, L, L, L, L, L, L, G, L, L, G, G, G, G, G, G, G, G, G, L, L },
471 /*INDX*/{ G, G, G, G, G, G, G, G, L, G, G, L, G, G, G, G, G, G, G, G, G, G, L },
472 /*RAN*/ { G, G, G, G, G, G, G, G, L, G, G, L, G, G, G, G, G, G, G, G, G, G, G }
473 } ;
474
475
476 /* Return an expr. */
477
478 static struct pnode *
parse()479 parse()
480 {
481 struct element stack[STACKSIZE];
482 int sp = 0, st, i;
483 struct element *top, *next;
484 struct pnode *pn, *lpn, *rpn;
485 char rel;
486
487 stack[0].e_token = END;
488 next = lexer();
489
490 while ((sp > 1) || (next->e_token != END)) {
491 /* Find the top-most terminal. */
492 i = sp;
493 do {
494 top = &stack[i--];
495 } while (top->e_token == VALUE);
496 rel = prectable[top->e_token][next->e_token];
497 switch (rel) {
498 case L:
499 case E:
500 /* Push the token read. */
501 if (sp == (STACKSIZE - 1)) {
502 fprintf(cp_err, "Error: stack overflow\n");
503 return (NULL);
504 }
505 bcopy((char *) next, (char *) &stack[++sp],
506 sizeof (struct element));
507 next = lexer();
508 continue;
509
510 case R:
511 fprintf(cp_err, "Syntax error.\n");
512 return (NULL);
513
514 case G:
515 /* Reduce. Make st and sp point to the elts on the
516 * stack at the end and beginning of the junk to
517 * reduce, then try and do some stuff. When scanning
518 * back for a <, ignore VALUES.
519 */
520 st = sp;
521 if (stack[sp].e_token == VALUE)
522 sp--;
523 while (sp > 0) {
524 if (stack[sp - 1].e_token == VALUE)
525 i = 2; /* No 2 pnodes together... */
526 else
527 i = 1;
528 if (prectable[stack[sp - i].e_token]
529 [stack[sp].e_token] == L)
530 break;
531 else
532 sp = sp - i;
533 }
534 if (stack[sp - 1].e_token == VALUE)
535 sp--;
536 /* Now try and see what we can make of this.
537 * The possibilities are: unop node
538 * node op node
539 * ( node )
540 * func ( node )
541 * node
542 * node [ node ] is considered node op node.
543 */
544 if (st == sp) {
545 pn = makepnode(&stack[st]);
546 if (pn == NULL)
547 goto err;
548 }
549 else if (((stack[sp].e_token == UMINUS) ||
550 (stack[sp].e_token == NOT)) &&
551 (st == sp + 1)) {
552 lpn = makepnode(&stack[st]);
553 if (lpn == NULL)
554 goto err;
555 pn = mkunode(stack[sp].e_token, lpn);
556 }
557 else if ((stack[sp].e_token == LPAREN) &&
558 (stack[st].e_token == RPAREN)) {
559 pn = makepnode(&stack[sp + 1]);
560 if (pn == NULL)
561 goto err;
562 }
563 else if ((stack[sp + 1].e_token == LPAREN) &&
564 (stack[st].e_token == RPAREN)) {
565 lpn = makepnode(&stack[sp + 2]);
566 if ((lpn == NULL) || (stack[sp].e_type !=
567 STRING))
568 goto err;
569 if (!(pn = mkfnode(stack[sp].e_string, lpn)))
570 return (NULL);
571 tfree(stack[sp].e_string);
572 }
573 else { /* node op node */
574 lpn = makepnode(&stack[sp]);
575 rpn = makepnode(&stack[st]);
576 if ((lpn == NULL) || (rpn == NULL))
577 goto err;
578 pn = mkbnode(stack[sp + 1].e_token,
579 lpn, rpn);
580 }
581 stack[sp].e_token = VALUE;
582 stack[sp].e_type = PNODE;
583 stack[sp].e_pnode = pn;
584 continue;
585 }
586 }
587 pn = makepnode(&stack[1]);
588 if (pn)
589 return (pn);
590 err:
591 fprintf(cp_err, "Syntax error.\n");
592 return (NULL);
593 }
594
595
596 /* Given a pointer to an element, make a pnode out of it (if it already
597 * is one, return a pointer to it). If it isn't of type VALUE, then return
598 * NULL.
599 */
600
601 static struct pnode *
makepnode(elem)602 makepnode(elem)
603
604 struct element *elem;
605 {
606 struct pnode *p;
607
608 if (elem->e_token != VALUE)
609 return (NULL);
610 switch (elem->e_type) {
611 case STRING:
612 p = mksnode(elem->e_string);
613 tfree(elem->e_string);
614 return (p);
615 case NUM:
616 return (mknnode(elem->e_double));
617 case PNODE:
618 return (elem->e_pnode);
619 default:
620 return (NULL);
621 }
622 }
623
624
625 /* Some auxiliary functions for building the parse tree. */
626
627 static
628 struct op ops[] = {
629 { PLUS, "+", 2, op_plus } ,
630 { MINUS, "-", 2, op_minus } ,
631 { TIMES, "*", 2, op_times } ,
632 { MOD, "%", 2, op_mod } ,
633 { DIVIDE,"/", 2, op_divide } ,
634 { COMMA, ",", 2, op_comma } ,
635 { POWER, "^", 2, op_power } ,
636 { EQ, "=", 2, op_eq } ,
637 { GT, ">", 2, op_gt } ,
638 { LT, "<", 2, op_lt } ,
639 { GE, ">=", 2, op_ge } ,
640 { LE, "<=", 2, op_le } ,
641 { NE, "<>", 2, op_ne } ,
642 { AND, "&", 2, op_and } ,
643 { OR, "|", 2, op_or } ,
644 { INDX, "[", 2, op_ind } ,
645 { RANGE, "[[", 2, op_range } ,
646 { 0, NULL, 0, NULL }
647 } ;
648
649 static
650 struct op uops[] = {
651 { UMINUS, "-", 1, op_uminus } ,
652 { NOT, "~", 1, op_not } ,
653 { 0, NULL, 0, NULL }
654 } ;
655
656 /* We have 'v' declared as a function, because if we don't then the defines
657 * we do for vm(), etc won't work. This is caught in evaluate(). Bad kludge.
658 */
659
660 struct func ft_funcs[] = {
661 { "mag", cx_mag } ,
662 { "magnitude", cx_mag } ,
663 { "ph", cx_ph } ,
664 { "phase", cx_ph } ,
665 { "j", cx_j } ,
666 { "real", cx_real } ,
667 { "re", cx_real } ,
668 { "imag", cx_imag } ,
669 { "im", cx_imag } ,
670 { "db", cx_db } ,
671 { "log", cx_log } ,
672 { "log10", cx_log } ,
673 { "ln", cx_ln } ,
674 { "exp", cx_exp } ,
675 { "abs", cx_mag } ,
676 { "sqrt", cx_sqrt } ,
677 { "sin", cx_sin } ,
678 { "cos", cx_cos } ,
679 { "tan", cx_tan } ,
680 { "atan", cx_atan } ,
681 { "norm", cx_norm } ,
682 { "rnd", cx_rnd } ,
683 { "gauss", cx_gauss } ,
684 { "pos", cx_pos } ,
685 { "mean", cx_mean } ,
686 { "vector", cx_vector } ,
687 { "unitvec", cx_unitvec } ,
688 { "length", cx_length } ,
689 { "interpolate", cx_interpolate } ,
690 { "deriv", cx_deriv } ,
691 { "v", NULL } ,
692 { NULL, NULL }
693 } ;
694
695 struct func func_uminus = { "minus", cx_uminus };
696
697 struct func func_not = { "not", cx_not };
698
699
700 /* Binop node. */
701
702 static struct pnode *
mkbnode(opnum,arg1,arg2)703 mkbnode(opnum, arg1, arg2)
704
705 struct pnode *arg1, *arg2;
706 {
707 struct op *o;
708 struct pnode *p;
709
710 for (o = &ops[0]; o->op_name; o++)
711 if (o->op_num == opnum)
712 break;
713 if (!o->op_name)
714 fprintf(cp_err, "mkbnode: Internal Error: no such op num %d\n",
715 opnum);
716 p = alloc(struct pnode);
717 p->pn_op = o;
718 p->pn_left = arg1;
719 p->pn_right = arg2;
720 return (p);
721 }
722
723
724 /* Unop node. */
725
726 static struct pnode *
mkunode(opnum,arg)727 mkunode(opnum, arg)
728
729 struct pnode *arg;
730 {
731 struct pnode *p;
732 struct op *o;
733
734 for (o = uops; o->op_name; o++)
735 if (o->op_num == opnum)
736 break;
737 if (!o->op_name)
738 fprintf(cp_err, "mkunode: Internal Error: no such op num %d\n",
739 opnum);
740
741 p = alloc(struct pnode);
742 p->pn_op = o;
743 p->pn_left = arg;
744 return (p);
745 }
746
747
748 /* Function node. We have to worry about a lot of things here. Something
749 * like f(a) could be three things -- a call to a standard function, which
750 * is easiest to deal with, a variable name, in which case we do the
751 * kludge with 0-length lists, or it could be a user-defined function,
752 * in which case we have to figure out which one it is, substitute for
753 * the arguments, and then return a copy of the expression that it was
754 * defined to be.
755 */
756
757 static struct pnode *
mkfnode(func,arg)758 mkfnode(func, arg)
759
760 char *func;
761 struct pnode *arg;
762 {
763 struct func *f;
764 struct pnode *p, *q;
765 struct dvec *d;
766 char buf[BSIZE_SP], *s;
767
768 (void) strcpy(buf, func);
769 for (s = buf; *s; s++) /* Make sure the case is ok. */
770 if (isupper(*s))
771 *s = tolower(*s);
772 for (f = &ft_funcs[0]; f->fu_name; f++)
773 if (eq(f->fu_name, buf))
774 break;
775 if (f->fu_name == NULL) {
776 /* Give the user-defined functions a try. */
777 q = ft_substdef(func, arg);
778 if (q)
779 return (q);
780 }
781 if ((f->fu_name == NULL) && arg->pn_value) {
782 /* Kludge -- maybe it is really a variable name. */
783 (void) sprintf(buf, "%s(%s)", func, arg->pn_value->v_name);
784 d = vec_get(buf);
785 if (d == NULL) {
786 /* Well, too bad. */
787 fprintf(cp_err, "Error: no such function as %s.\n",func);
788 return (NULL);
789 }
790 return (mksnode(buf));
791 }
792 else if (f->fu_name == NULL) {
793 fprintf(cp_err, "Error: no function as %s with that arity.\n",
794 func);
795 return (NULL);
796 }
797 p = alloc(struct pnode);
798 p->pn_func = f;
799 p->pn_left = arg;
800 return (p);
801 }
802
803
804 /* Number node. */
805
806 static struct pnode *
mknnode(number)807 mknnode(number)
808
809 double number;
810 {
811 struct pnode *p;
812 struct dvec *v;
813 char buf[BSIZE_SP];
814
815 p = alloc(struct pnode);
816 v = alloc(struct dvec);
817 p->pn_value = v;
818 p->pn_func = NULL;
819 p->pn_op = NULL;
820 p->pn_left = p->pn_right = NULL;
821
822 /* We don't use printnum because it screws up mkfnode above. We have
823 * to be careful to deal properly with node numbers that are quite
824 * large...
825 */
826 if (number < MAXPOSINT)
827 (void) sprintf(buf, "%d", (int) number);
828 else
829 (void) sprintf(buf, "%G", number);
830 v->v_name = copy(buf);
831 v->v_type = SV_NOTYPE;
832 v->v_flags = VF_REAL;
833 v->v_realdata = (double *) tmalloc(sizeof (double));
834 *v->v_realdata = number;
835 v->v_length = 1;
836 vec_newtemp(v);
837 return (p);
838 }
839
840
841 /* String node. */
842
843 static struct pnode *
mksnode(string)844 mksnode(string)
845
846 char *string;
847 {
848 struct dvec *v, *nv, *vs, *newv = NULL, *end = NULL;
849 struct pnode *p;
850
851 p = alloc(struct pnode);
852 v = vec_get(string);
853 if (v == NULL) {
854 nv = alloc(struct dvec);
855 p->pn_value = nv;
856 nv->v_name = copy(string);
857 vec_newtemp(nv);
858 return (p);
859 }
860 if (!v->v_link2) {
861 v = vec_copy(v);
862 vec_newtemp(v);
863 }
864 p->pn_value = v;
865 return (p);
866 }
867
868
869 /* free a pnode structure */
870
871 void
inp_pnfree(p)872 inp_pnfree(p)
873 struct pnode *p;
874 {
875 if (!p) return;
876 if (p->pn_name) txfree(p->pn_name);
877 if (p->pn_left) inp_pnfree(p->pn_left);
878 if (p->pn_right) inp_pnfree(p->pn_right);
879 if (p->pn_next) inp_pnfree(p->pn_next);
880 txfree((char*)p);
881 }
882