Jspice3
define.c
Go to the documentation of this file.
1 /***************************************************************************
2 JSPICE3 adaptation of Spice3f2 - 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  * User-defined functions. The user defines the function with
10  * define func(arg1, arg2, arg3) <expression involving args...>
11  * Then when he types "func(1, 2, 3)", the commas are interpreted as
12  * binary operations of the lowest priority by the parser, and ft_substdef()
13  * below is given a chance to fill things in and return what the parse tree
14  * would have been had the entire thing been typed.
15  * Note that we have to take some care to distinguish between functions
16  * with the same name and different arities.
17  */
18 
19 #include "spice.h"
20 #include "ftedefs.h"
21 
22 #ifdef __STDC__
23 static void savetree(struct pnode*);
24 static void prdefs(char*);
25 static void prtree(struct udfunc*);
26 static void prtree1(struct pnode*);
27 static struct pnode *trcopy(struct pnode*,char*,struct pnode*);
28 static struct pnode *ntharg(int,struct pnode*);
29 #else
30 static void savetree();
31 static void prdefs();
32 static void prtree();
33 static void prtree1();
34 static struct pnode *trcopy();
35 static struct pnode *ntharg();
36 #endif
37 
38 static struct udfunc *udfuncs = NULL;
39 
40 
41 /* Set up a function definition. */
42 
43 void
44 com_define(wlist)
45 
46 wordlist *wlist;
47 {
48  int arity = 0, i;
49  char buf[BSIZE_SP], tbuf[BSIZE_SP], *s, *t, *b;
50  wordlist *wl, *cwl;
51  struct pnode *pn;
52  struct udfunc *udf;
53 
54  /* If there's nothing then print all the definitions. */
55  if (wlist == NULL) {
56  prdefs((char *) NULL);
57  return;
58  }
59 
60  /* Accumulate the function head in the buffer, w/out spaces. A
61  * useful thing here would be to check to make sure that there
62  * are no formal parameters here called "list". But you have
63  * to try really hard to break this here.
64  */
65  buf[0] = '\0';
66  for (wl = wlist; wl && (strchr(wl->wl_word,')') == NULL);
67  wl = wl->wl_next)
68  (void) strcat(buf, wl->wl_word);
69 
70  cwl = wl = wl_copy(wl);
71  if (wl) {
72  for (t = buf; *t; t++);
73  for (s = wl->wl_word; *s && (*s != ')'); s++, t++)
74  *t = *s;
75  *t++ = ')';
76  *t = '\0';
77  if (*++s) {
78  tfree(wl->wl_word);
79  wl->wl_word = copy(s);
80  }
81  else
82  wl = wl->wl_next;
83  }
84 
85  /* If that's all, then print the definition. */
86  if (wl == NULL) {
87  prdefs(buf);
88  wl_free(cwl);
89  return;
90  }
91 
92  /* Now check to see if this is a valid name for a function (i.e,
93  * there isn't a predefined function of the same name).
94  */
95  (void) strcpy(tbuf, buf);
96  for (b = tbuf; *b; b++)
97  if (isspace(*b) || (*b == '(')) {
98  *b = '\0';
99  break;
100  }
101  for (i = 0; ft_funcs[i].fu_name; i++)
102  if (eq(ft_funcs[i].fu_name, tbuf)) {
103  fprintf(cp_err, "Error: %s is a predefined function.\n",tbuf);
104  wl_free(cwl);
105  return;
106  }
107 
108  /* Parse the rest of it. We can't know if there are the right
109  * number of undefined variables in the expression.
110  */
111  if (!(pn = ft_getpnames(wl, false))) {
112  wl_free(cwl);
113  return;
114  }
115 
116  /* This is a pain -- when things are garbage-collected, any
117  * vectors that may have been mentioned here will be thrown
118  * away. So go down the tree and save any vectors that aren't
119  * formal parameters.
120  */
121  savetree(pn);
122 
123  /* Format the name properly and add to the list. */
124  b = copy(buf);
125  for (s = b; *s; s++) {
126  if (*s == '(') {
127  *s = '\0';
128  if (s[1] != ')')
129  arity++; /* It will have been 0. */
130  }
131  else if (*s == ')') {
132  *s = '\0';
133  }
134  else if (*s == ',') {
135  *s = '\0';
136  arity++;
137  }
138  }
139  for (udf = udfuncs; udf; udf = udf->ud_next)
140  if (prefix(b, udf->ud_name) && (arity == udf->ud_arity))
141  break;
142  if (udf == NULL) {
143  udf = alloc(struct udfunc);
144  if (udfuncs == NULL)
145  udfuncs = udf;
146  else {
147  udf->ud_next = udfuncs;
148  udfuncs = udf;
149  }
150  }
151  else {
152  inp_pnfree(udf->ud_text);
153  tfree(udf->ud_name);
154  }
155  udf->ud_text = pn;
156  udf->ud_name = b;
157  udf->ud_arity = arity;
159  wl_free(cwl);
160  return;
161 }
162 
163 
164 /* Kludge. */
165 
166 static void
168 
169 struct pnode *pn;
170 {
171  struct dvec *d;
172 
173  if (pn->pn_value) {
174  /* We specifically don't add this to the plot list
175  * so it won't get gc'ed.
176  */
177  d = pn->pn_value;
178  if ((d->v_length != 0) || eq(d->v_name, "list")) {
179  pn->pn_value = alloc(struct dvec);
180  pn->pn_value->v_name = copy(d->v_name);
181  pn->pn_value->v_length = d->v_length;
182  pn->pn_value->v_type = d->v_type;
183  pn->pn_value->v_flags = d->v_flags;
184  pn->pn_value->v_plot = d->v_plot;
185  if (isreal(d)) {
186  pn->pn_value->v_realdata =
187  (double *) tmalloc(sizeof(double) * d->v_length);
188  DCOPY(d->v_realdata, pn->pn_value->v_realdata, d->v_length);
189  }
190  else {
191  pn->pn_value->v_compdata =
192  (complex *) tmalloc(sizeof(complex) * d->v_length);
193  CCOPY(d->v_compdata, pn->pn_value->v_compdata, d->v_length);
194  }
195  }
196  }
197  else if (pn->pn_op) {
198  savetree(pn->pn_left);
199  if (pn->pn_op->op_arity == 2)
200  savetree(pn->pn_right);
201  }
202  else if (pn->pn_func) {
203  savetree(pn->pn_left);
204  }
205  return;
206 }
207 
208 
209 /* A bunch of junk to print out nodes. */
210 
211 static void
212 prdefs(name)
213 
214 char *name;
215 {
216  struct udfunc *udf;
217  char *s;
218 
219  if (name) {
220  s = strchr(name, '(' /* ) */);
221  if (s)
222  *s = '\0';
223  }
224  out_send("\n");
225  if (name && *name) { /* You never know what people will do */
226  for (udf = udfuncs; udf; udf = udf->ud_next)
227  if (eq(name, udf->ud_name))
228  prtree(udf);
229  }
230  else
231  for (udf = udfuncs; udf; udf = udf->ud_next)
232  prtree(udf);
233  out_send("\n");
234  if (s) *s = '(';
235  return;
236 }
237 
238 
239 /* Print out one definition. */
240 
241 static void
243 
244 struct udfunc *ud;
245 {
246  char *s, buf[BSIZE_SP];
247 
248  /* Print the head. */
249  buf[0] = '\0';
250  (void) strcat(buf, ud->ud_name);
251  for (s = ud->ud_name; *s; s++);
252  (void) strcat(buf, " (");
253  s++;
254  while (*s) {
255  (void) strcat(buf, s);
256  while (*s)
257  s++;
258  if (s[1])
259  (void) strcat(buf, ", ");
260  s++;
261  }
262  (void) strcat(buf, ") = ");
263  out_send(buf);
264  prtree1(ud->ud_text);
265  out_send("\n");
266  return;
267 }
268 
269 
270 static void
272 
273 struct pnode *pn;
274 {
275  if (pn->pn_value) {
276  out_send(pn->pn_value->v_name);
277  }
278  else if (pn->pn_func) {
279  out_printf("%s (", pn->pn_func->fu_name);
280  prtree1(pn->pn_left);
281  out_send(")");
282  }
283  else if (pn->pn_op && (pn->pn_op->op_arity == 2)) {
284  out_send("(");
285  prtree1(pn->pn_left);
286  out_printf(")%s(", pn->pn_op->op_name);
287  prtree1(pn->pn_right);
288  out_send(")");
289  }
290  else if (pn->pn_op && (pn->pn_op->op_arity == 1)) {
291  out_printf("%s(", pn->pn_op->op_name);
292  prtree1(pn->pn_left);
293  out_send(")");
294  }
295  else
296  out_send("<something strange>");
297  return;
298 }
299 
300 
301 struct pnode *
302 ft_substdef(name, args)
303 
304 char *name;
305 struct pnode *args;
306 {
307  struct udfunc *udf;
308  struct pnode *tp;
309  char *s;
310  int arity = 0, rarity;
311  bool found = false;
312 
313  if (args)
314  arity = 1;
315  for (tp = args; tp && tp->pn_op && (tp->pn_op->op_num == COMMA); tp =
316  tp->pn_right)
317  arity++;
318  for (udf = udfuncs; udf; udf = udf->ud_next)
319  if (eq(name, udf->ud_name)) {
320  if (arity == udf->ud_arity)
321  break;
322  else {
323  found = true;
324  rarity = udf->ud_arity;
325  }
326  }
327  if (udf == NULL) {
328  if (found)
329  fprintf(cp_err,
330  "Warning: the user-defined function %s has %d args\n",
331  name, rarity);
332  return (NULL);
333  }
334  for (s = udf->ud_name; *s; s++)
335  ;
336  s++;
337 
338  /* Now we have to traverse the tree and copy it over,
339  * substituting args.
340  */
341  return (trcopy(udf->ud_text, s, args));
342 }
343 
344 
345 /* Copy the tree and replace formal args with the right stuff. The way
346  * we know that something might be a formal arg is when it is a dvec
347  * with length 0 and a name that isn't "list". I hope nobody calls their
348  * formal parameters "list".
349  */
350 
351 static struct pnode *
352 trcopy(tree, args, nn)
353 
354 struct pnode *tree;
355 char *args;
356 struct pnode *nn;
357 {
358  struct pnode *pn;
359  struct dvec *d;
360  struct func *func;
361  struct op *op;
362  char *s, *t;
363  int i;
364 
365  if (tree->pn_value) {
366  d = tree->pn_value;
367  if ((d->v_length == 0) && strcmp(d->v_name, "list")) {
368  /* Yep, it's a formal parameter. Substitute for it.
369  * IMPORTANT: we never free parse trees, so we
370  * needn't worry that they aren't trees here.
371  */
372  s = args;
373  i = 1;
374  while (*s) {
375  if (eq(s, d->v_name))
376  return (ntharg(i, nn));
377  if (ciprefix("v(",d->v_name)) {
378  if (ciprefix(s,d->v_name+2)) {
379  t = d->v_name + strlen(s) + 2;
380  while (*t && isspace(*t)) t++;
381  if (*t == ')') {
382  pn = alloc(struct pnode);
383  func = alloc(struct func);
384  pn->pn_func = func;
385  func->fu_func = NULL;
386  func->fu_name = copy("v");
387  pn->pn_left = ntharg(i, nn);
388  return (pn);
389  }
390  }
391  }
392  i++;
393  while (*s++); /* Get past the last '\0'. */
394  }
395  }
396  return (NULL);
397  }
398  else if (tree->pn_func) {
399  pn = alloc(struct pnode);
400  func = alloc(struct func);
401  pn->pn_func = func;
402  func->fu_name = copy(tree->pn_func->fu_name);
403  func->fu_func = tree->pn_func->fu_func;
404  pn->pn_left = trcopy(tree->pn_left, args, nn);
405  }
406  else if (tree->pn_op) {
407  pn = alloc(struct pnode);
408  op = alloc(struct op);
409  pn->pn_op = op;
410  op->op_num = tree->pn_op->op_num;
411  op->op_arity = tree->pn_op->op_arity;
412  op->op_func = tree->pn_op->op_func;
413  op->op_name = copy(tree->pn_op->op_name);
414  pn->pn_left = trcopy(tree->pn_left, args, nn);
415  if (op->op_arity == 2)
416  pn->pn_right = trcopy(tree->pn_right, args, nn);
417  }
418  else {
419  fprintf(cp_err, "trcopy: Internal Error: bad parse node\n");
420  return (NULL);
421  }
422  return (pn);
423 }
424 
425 
426 /* Find the n'th arg in the arglist, returning NULL if there isn't one.
427  * Since comma has such a low priority and associates to the right,
428  * we can just follow the right branch of the tree num times.
429  * Note that we start at 1 when numbering the args.
430  */
431 
432 static struct pnode *
433 ntharg(num, args)
434 
435 struct pnode *args;
436 {
437  struct pnode *ptry;
438 
439  ptry = args;
440  if (num > 1) {
441  while (--num > 0) {
442  if (ptry && ptry->pn_op &&
443  (ptry->pn_op->op_num != COMMA))
444  if (num == 1)
445  break;
446  else
447  return (NULL);
448  ptry = ptry->pn_right;
449  }
450  }
451  if (ptry && ptry->pn_op && (ptry->pn_op->op_num == COMMA))
452  ptry = ptry->pn_left;
453  return (ptry);
454 }
455 
456 
457 void
459 
460 wordlist *wlist;
461 {
462  struct udfunc *udf, *ludf = NULL, *udn;
463 
464  if (!wlist)
465  return;
466  if (*wlist->wl_word == '*' || eq(wlist->wl_word,"all")) {
467  for (udf = udfuncs; udf; udf = udn) {
468  udn = udf->ud_next;
469  inp_pnfree(udf->ud_text);
470  tfree(udf->ud_name);
471  tfree(udf);
472  }
473  udfuncs = NULL;
474  return;
475  }
476  while (wlist) {
477  for (udf = udfuncs; udf; udf = udf->ud_next) {
478  if (eq(wlist->wl_word, udf->ud_name)) {
479  if (ludf)
480  ludf->ud_next = udf->ud_next;
481  else
482  udfuncs = udf->ud_next;
483  cp_remkword(CT_UDFUNCS, wlist->wl_word);
484  inp_pnfree(udf->ud_text);
485  tfree(udf->ud_name);
486  tfree(udf);
487  }
488  else
489  ludf = udf;
490  }
491  wlist = wlist->wl_next;
492  }
493  return;
494 }
struct func ft_funcs[]
Definition: parse.c:660
static char buf[MAXPROMPT]
Definition: arg.c:18
#define BSIZE_SP
Definition: misc.h:19
#define CT_UDFUNCS
Definition: fteconst.h:94
#define eq(a, b)
Definition: misc.h:29
int ciprefix()
#define prefix(x, y)
Definition: readhelp.c:39
void out_printf()
char * strcpy()
Definition: cddefs.h:119
static void savetree()
struct func * pn_func
Definition: fteparse.h:19
struct pnode * ft_getpnames()
#define COMMA
Definition: fteparse.h:84
static struct pnode * ntharg()
void com_define(wordlist *wlist)
Definition: define.c:44
Definition: cpstd.h:29
Definition: library.c:18
char * fu_name
Definition: fteparse.h:38
#define alloc(type)
Definition: cdmacs.h:21
complex * v_compdata
Definition: ftedata.h:29
#define DCOPY(s, d, n)
Definition: ftedefs.h:55
static struct pnode * trcopy()
#define CCOPY(s, d, n)
Definition: ftedefs.h:59
char * copy()
void wl_free()
void inp_pnfree()
FILE * cp_err
Definition: help.c:101
struct pnode * ft_substdef(char *name, struct pnode *args)
Definition: define.c:302
char * tmalloc()
struct pnode * ud_text
Definition: fteparse.h:50
void cp_remkword()
Definition: cddefs.h:237
void com_undefine(wordlist *wlist)
Definition: define.c:458
#define tfree(x)
Definition: cdmacs.h:22
#define NULL
Definition: spdefs.h:121
static struct udfunc * udfuncs
Definition: define.c:38
int op_num
Definition: fteparse.h:29
struct plot * v_plot
Definition: ftedata.h:42
struct dvec *(* op_func)()
Definition: fteparse.h:32
struct op * pn_op
Definition: fteparse.h:20
#define isreal(v)
Definition: ftedata.h:54
Definition: ftedata.h:24
Definition: fteparse.h:28
char * v_name
Definition: ftedata.h:25
struct wl * wl_next
Definition: library.c:20
static void prtree1()
Definition: cpstd.h:21
Definition: fteparse.h:37
int v_type
Definition: ftedata.h:26
char * op_name
Definition: fteparse.h:30
struct udfunc * ud_next
Definition: fteparse.h:51
char * ud_name
Definition: fteparse.h:48
void out_send()
char op_arity
Definition: fteparse.h:31
char * wl_word
Definition: cpstd.h:22
int ud_arity
Definition: fteparse.h:49
int v_length
Definition: ftedata.h:34
struct pnode * pn_right
Definition: fteparse.h:22
static void prtree()
short v_flags
Definition: ftedata.h:27
double * v_realdata
Definition: ftedata.h:28
void cp_addkword()
struct pnode * pn_left
Definition: fteparse.h:21
Definition: cddefs.h:192
char *(* fu_func)()
Definition: fteparse.h:39
static void prdefs()
Definition: fteparse.h:16
wordlist * wl_copy()