source: trunk/minix/commands/awk/e.c@ 9

Last change on this file since 9 was 9, checked in by Mattia Monga, 13 years ago

Minix 3.1.2a
File size: 16.6 KB
Line 
1/*
2 * a small awk clone
3 *
4 * (C) 1989 Saeko Hirabauashi & Kouichi Hirabayashi
5 *
6 * Absolutely no warranty. Use this software with your own risk.
7 *
8 * Permission to use, copy, modify and distribute this software for any
9 * purpose and without fee is hereby granted, provided that the above
10 * copyright and disclaimer notice.
11 *
12 * This program was written to fit into 64K+64K memory of the Minix 1.2.
13 */
14
15
16#include <stdio.h>
17#include <ctype.h>
18#include "awk.h"
19#include "regexp.h"
20
21extern char **FS, **OFS, **ORS, **OFMT;
22extern double *RSTART, *RLENGTH;
23extern char record[];
24extern CELL *field[];
25
26extern int r_start, r_length;
27
28double getfval(), atof();
29char *strsave(), *getsval(), *strcat(), *strstr();
30CELL *mkcell(), *mktmp();
31CELL *Field(), *Split(), *Forin();
32CELL *Arith(), *Assign(), *Stat(), *Mathfun(), *Strfun(), *Cond();
33CELL *Print(), *Cat(), *Array(), *Element();
34CELL *If(), *While(), *For(), *Do(), *Jump();
35CELL *P1stat(), *P2stat(), *Print0();
36CELL *Arg(), *Call(), *Ret();
37CELL *Subst(), *In(), *Getline(), *Delete(), *Close();
38CELL *Nulproc(), *Usrfun();
39CELL *_Arg();
40
41FILE *getfp(); /* r.c */
42
43CELL truecell = { NUM, NULL, 1.0 };
44CELL falsecell = { NUM, NULL, 0.0 };
45static CELL breakcell = { BRK, NULL, 0.0 };
46static CELL contcell = { CNT, NULL, 0.0 };
47static CELL nextcell = { NXT, NULL, 0.0 };
48static CELL retcell = { RTN, NULL, 0.0 };
49
50static CELL *retval; /* function return value */
51
52int pateval; /* used in P1STAT & P2STAT */
53static char *r_str; /* STR in 'str ~ STR */
54static regexp *r_pat; /* compiled pattern for STR */
55
56CELL *(*proctab[])() = {
57 Arg, Arith, Array, Assign, Call, Cat, Cond, Delete, Do, Element,
58 Field, For, Forin, Getline, If, In, Jump, Mathfun, Nulproc, P1stat,
59 P2stat, Print, Print0, Strfun, Subst, Usrfun, While
60};
61
62CELL *
63execute(p) NODE *p;
64{
65 int type, i;
66 CELL *r, *(*proc)();
67
68 type = p->n_type;
69 if (type == VALUE) {
70 if ((r = (CELL *) p->n_arg[0])->c_type & PAT && pateval) {
71 i = match(r->c_sval, (char *)record) ? 1 : 0;
72 r = mktmp(NUM, NULL, (double) i);
73 }
74 return r;
75 }
76 for ( ; p != NULL; p = p->n_next) {
77#if 0
78 if (p->n_type == VALUE) continue; /* neglect */
79#endif
80/*
81 switch ((int) p->n_type) {
82 case ARRAY:
83 r = Array(p);
84 break;
85 case ARITH:
86 r = Arith(p);
87 break;
88 case ASSIGN:
89 r = Assign(p);
90 break;
91 case PRINT:
92 r = Print(p);
93 break;
94 case PRINT0:
95 r = Print0(p);
96 break;
97 case CAT:
98 r = Cat(p);
99 break;
100 case MATHFUN:
101 r = Mathfun(p);
102 break;
103 case STRFUN:
104 r = Strfun(p);
105 break;
106 case COND:
107 r = Cond(p);
108 break;
109 case IF:
110 r = If(p);
111 break;
112 case P1STAT:
113 r = P1stat(p);
114 break;
115 case P2STAT:
116 r = P2stat(p);
117 break;
118 case WHILE:
119 r = While(p);
120 break;
121 case DO:
122 r = Do(p);
123 break;
124 case FOR:
125 r = For(p);
126 break;
127 case FORIN:
128 r = Forin(p);
129 break;
130 case FIELD:
131 r = Field(p);
132 break;
133 case JUMP:
134 r = Jump(p);
135 break;
136 case ARG:
137 r = Arg(p);
138 break;
139 case CALL:
140 r = Call(p);
141 break;
142 case SUBST:
143 r = Subst(p);
144 break;
145 case ELEMENT:
146 r = Element(p);
147 break;
148 case IN:
149 r = In(p);
150 break;
151 case GETLINE:
152 r = Getline(p);
153 break;
154 case DELETE:
155 r = Delete(p);
156 break;
157 case NULPROC:
158 r = &truecell;
159 break;
160 default:
161 printf("PROGRAM ERROR ? ILLEGAL NODE TYPE(%d)\n", type);
162 exit(1);
163 break;
164 }
165*/
166 i = (int) p->n_type;
167 if (i < FIRSTP || i > LASTP)
168 error("ILLEGAL PROC (%d)", i);
169 proc = proctab[i - FIRSTP];
170 r = (*proc)(p);
171 if (r->c_type & (BRK|CNT|NXT|RTN))
172 return r;
173 if (p->n_next != NULL)
174 c_free(r);
175#ifdef DOS
176 kbhit(); /* needs in MS-DOS */
177#endif
178 }
179 return r;
180}
181
182static CELL *
183Arith(p) NODE *p;
184{
185 int op;
186 CELL *r, *u, *v, *execute();
187 double x, y, fmod(), pow();
188
189 op = (int) p->n_arg[0];
190 if (op == UMINUS) {
191 u = execute(p->n_arg[1]);
192 x = - getfval(u);
193 }
194 else if (op == INCDEC) {
195 u = execute(p->n_arg[1]);
196 x = getfval(u);
197 setfval(u, x + (int) p->n_arg[2]);
198 if ((int) p->n_arg[3] == PRE)
199 return u;
200 /* return dummy */
201 }
202 else {
203 u = execute(p->n_arg[1]);
204 v = execute(p->n_arg[2]);
205 x = getfval(u);
206 y = getfval(v);
207 if (op == DIV || op == MOD) {
208 if (y == 0.0)
209 fprintf(stderr, "divid by 0\n");
210 }
211 switch (op) {
212 case SUB: x -= y;break;
213 case ADD: x += y; break;
214 case MULT: x *= y; break;
215 case DIV:
216 if (y == 0.0)
217 error("division by zero in \"/\"", (char *)0);
218 x /= y; break;
219 case MOD:
220 if (y == 0.0)
221 error("division by zero in \"%%\"", (char *)0);
222 x = fmod(x, y); break;
223 case POWER: x = pow(x, y); break;
224 default: printf("UNSUPPORTED ARITH OPERATOR !\n"); break;
225 }
226 c_free(v);
227 }
228 c_free(u);
229 r = mktmp(NUM, NULL, x);
230 return r;
231}
232
233static CELL *
234Assign(p) NODE *p;
235{
236 CELL *u, *v, *execute();
237 int op;
238 double x, y, fmod(), pow();
239
240 op = (int) p->n_arg[0];
241 u = execute(p->n_arg[1]);
242
243#if 0
244 if (u->c_type == UDF) /* fix up local var */
245 u->c_type |= VAR|STR;
246#endif
247 if (!(u->c_type & (VAR|FLD|REC)) && (u->c_type != UDF))
248 fprintf(stderr, "ASSIGN TO NON VARIABLE (%d)\n", u->c_type);
249 v = execute(p->n_arg[2]);
250
251 if (u == v)
252 goto rtn; /* same node */
253
254 if (op == ASSIGN) {
255 if (v->c_type & NUM/* || isnum(v->c_sval)*/)
256 setfval(u, getfval(v));
257 else
258 setsval(u, getsval(v));
259 }
260 else {
261 x = getfval(u);
262 y = getfval(v);
263 switch (op) {
264 case ADDEQ: x += y; break;
265 case SUBEQ: x -= y; break;
266 case MULTEQ: x *= y; break;
267 case DIVEQ:
268 if (y == 0.0)
269 error("division by zero in \"/=\"", (char *)0);
270 x /= y; break;
271 case MODEQ:
272 if (y == 0.0)
273 error("division by zero in \"%=\"", (char *)0);
274 x = fmod(x, y); break;
275 case POWEQ: x = pow(x, y); break;
276 default:
277 synerr("illegal assign op (%d)", op);
278 break;
279 }
280 setfval(u, x);
281 }
282rtn:
283 c_free(v);
284 return u;
285}
286
287static CELL *
288Cat(p) NODE *p;
289{
290 CELL *u;
291 char *s, *t, str[BUFSIZ];
292
293 u = execute(p->n_arg[0]);
294 s = getsval(u);
295 for (t = str; *s; )
296 *t++ = *s++;
297 c_free(u);
298 u = execute(p->n_arg[1]);
299 s = getsval(u);
300 while (*s)
301 *t++ = *s++;
302 c_free(u);
303 *t = '\0';
304 return mktmp(STR, str, 0.0);
305}
306
307static CELL *
308Print(p) NODE *p;
309{
310 register int i, redir, typ;
311 CELL *u;
312 char *s, str[BUFSIZ];
313 char *file;
314 FILE *fp;
315
316 redir = (int) p->n_arg[0];
317 if (typ = redir & PRMASK) { /* redirect */
318 u = execute(p->n_arg[1]);
319 file = getsval(u);
320 if (typ == R_PIPE)
321 typ = R_POUT;
322 fp = getfp(file, typ);
323 c_free(u);
324 }
325 else
326 fp = stdout;
327 if (redir & FORMAT) /* format */
328 format(str, p);
329 else {
330 *str = '\0';
331 for (i = 2; p->n_arg[i] != NULL; i++) {
332 if (i > 2)
333 strcat(str, *OFS);
334 u = execute(p->n_arg[i]);
335 s = getsval(u);
336 strcat(str, s);
337 c_free(u);
338 }
339 strcat(str, *ORS);
340 }
341 if (redir & STROUT) /* sprintf */
342 return mktmp(STR, str, 0.0);
343 fputs(str, fp);
344 fflush(fp);
345 return &truecell;
346}
347
348static CELL *
349Mathfun(p) NODE *p;
350{
351 CELL *u, *v;
352 double x, y;
353 double atan2(), cos(), exp(), log(), sin(), sqrt(), modf();
354
355 if ((int) p->n_arg[1] == 0) {
356 u = NULL;
357 x = 0.0;
358 }
359 else {
360 u = execute(p->n_arg[2]);
361 x = getfval(u);
362 }
363 switch ((int) p->n_arg[0]) {
364 case ATAN2:
365 if ((int) p->n_arg[1] == 2) {
366 v = execute(p->n_arg[3]);
367 y = getfval(v);
368 x = atan2(x, y);
369 c_free(v);
370 }
371 else
372 x = 0.0;
373 break;
374 case COS: x = cos(x); break;
375 case EXP: x = exp(x); break;
376 case INT: y = modf(x, &x); break;
377 case LOG: x = log(x); break;
378 case SIN: x = sin(x); break;
379 case SQRT: x = sqrt(x); break;
380 case RAND: x = (double) rand() / 32768.0; break;
381 case SRAND: if (x == 0.0)
382 x = (double) time(0);
383 x = (double) srand((int) x);
384 break;
385 default:
386 fprintf(stderr, "unknown math function (%d)\n", p->n_arg[2]);
387 break;
388 }
389 if (u != NULL)
390 c_free(u);
391 return mktmp(NUM, NULL, x);
392}
393
394static CELL *
395Strfun(p) NODE *p;
396{
397 CELL *u, *v, *r;
398 char *s, *t, str[BUFSIZ];
399 int i, m, n;
400 double x;
401 regexp *pat, *getpat();
402
403 n = (int) p->n_arg[1];
404 if (n > 0 && (int) p->n_arg[0] != SPLIT) {
405 u = execute(p->n_arg[2]);
406 s = getsval(u);
407 }
408 else {
409 s = "";
410 u = NULL;
411 }
412 switch ((int) p->n_arg[0]) {
413 case INDEX:
414 if (n > 1) {
415 v = execute(p->n_arg[3]);
416 t = getsval(v);
417 i = Index(s, t);
418 c_free(v);
419 }
420 else
421 i = 0;
422 r = mktmp(NUM, NULL, (double) i);
423 break;
424 case LENGTH:
425 i = (n > 0) ? jstrlen(s) : jstrlen(record);
426 r = mktmp(NUM, NULL, (double) i);
427 break;
428 case SPLIT:
429 r = Split(p);
430 break;
431 case SUBSTR:
432 if (n > 1) {
433 v = execute(p->n_arg[3]);
434 m = (int) getfval(v) - 1;
435 c_free(v);
436 }
437 else
438 m = 0;
439 if (n > 2) {
440 v = execute(p->n_arg[4]);
441 n = (int) getfval(v);
442 c_free(v);
443 }
444 else
445 n = jstrlen(s) - m;
446 for (t = str; *s && m-- > 0; s++)
447 if (isKanji(*s))
448 s++;
449 while (*s && n-- > 0) {
450 if (isKanji(*s))
451 *t++ = *s++;
452 *t++ = *s++;
453 }
454 *t = '\0';
455 r = mktmp(STR, str, 0.0);
456 break;
457 case RMATCH:
458 if (n > 1) {
459 v = execute(p->n_arg[3]);
460 pat = getpat(v);
461 match(pat, s);
462 c_free(v);
463 if (r_start) { /* change only if match */
464 *RSTART = (double) r_start;
465 *RLENGTH = (double) r_length;
466 }
467 r = mktmp(NUM, NULL, (double) r_start);
468 }
469 else
470 error("missing regexpr in match(str, regexpr)");
471 break;
472 case CLOSE:
473 r = Close(s);
474 break;
475 case SYSTEM:
476 r = mktmp(NUM, NULL, system(s) == -1 ? 0.0 : 1.0);
477 break;
478 default:
479 fprintf(stderr, "unknown string function");
480 break;
481 }
482 c_free(u);
483 return r;
484}
485
486static regexp *
487getpat(r) CELL *r;
488{
489 regexp *pat, *mkpat();
490
491 if (r->c_type & PAT)
492 pat = (regexp *) r->c_sval;
493 else {
494 if (r_str && strcmp(r_str, r->c_sval) == 0)
495 pat = r_pat;
496 else {
497 sfree(r_str); sfree(r_pat);
498 r_str = strsave(getsval(r));
499 pat = r_pat = mkpat(r_str);
500 }
501 }
502 return pat;
503}
504
505static CELL *
506Subst(p) NODE *p;
507{
508 CELL *u, *v, *w;
509 char *s, *t, *r, str[BUFSIZ], *strcpy();
510 int i, n;
511
512 n = (int) p->n_arg[1];
513 if (n > 1) {
514 u = execute(p->n_arg[3]); /* substitute string */
515 s = getsval(u);
516 v = execute(p->n_arg[2]); /* expr */
517 if (n > 2) {
518 w = execute(p->n_arg[4]);
519 t = getsval(w);
520 r = str;
521 }
522 else {
523 t = r = record;
524 w = NULL;
525 }
526 i = (int) p->n_arg[0] == RGSUB ? 0 : 1;
527 if (v->c_type & (PAT|STR))
528 i = Sub(r, v->c_sval, (v->c_type & STR), s, t, i);
529 else
530 error("[g]sub(PAT, .. ) must be /../ or string (%d)",
531 w->c_type);
532 if (n > 2) {
533 if (w->c_type & REC) {
534 strcpy(record, str);
535 mkfld(record, *FS, field);
536 }
537 else
538 setsval(w, str);
539 }
540 else
541 mkfld(record, *FS, field);
542 c_free(u);
543 c_free(v);
544 c_free(w);
545 }
546 else
547 i = 0;
548 return mktmp(NUM, NULL, (double) i);
549}
550
551static CELL *
552Cond(p) NODE *p;
553{
554 CELL *u, *v;
555 double x, y;
556 int op, i, j;
557 char *s;
558 int save = pateval;
559
560 op = (int) p->n_arg[0];
561 u = execute(p->n_arg[1]);
562 x = getfval(u);
563/*
564printf("Cond(%d)(%s)\n", u->c_type, u->c_sval);
565*/
566 if (op == AND || op == OR || op == NOT) {
567 if (u->c_type & NUM)
568 i = (x != 0.0);
569 else {
570 s = getsval(u);
571 i = (s != (char *)NULL) && (*s != '\0');
572 }
573 }
574 if (op == AND && !i) {
575 c_free(u);
576 return &falsecell;
577 }
578 if (op == OR && i) {
579 c_free(u);
580 return &truecell;
581 }
582 if (op == NOT)
583 i = i == 0 ? 1 : 0;
584 else {
585 if (op == MATCH || op == NOMATCH)
586 pateval = 0;
587 v = execute(p->n_arg[2]);
588 y = getfval(v);
589 if (op == AND || op == OR || op == BINAND || op == BINOR) {
590 if (v->c_type & NUM)
591 j = (y != 0.0);
592 else {
593 s = getsval(v);
594 j = (s != (char *)NULL) && (*s != '\0');
595 }
596 switch (op) {
597 case AND: i = i && j; break;
598 case OR: i = i || j; break;
599 case BINAND: i = i & j; break;
600 case BINOR: i = i | j; break;
601 }
602 }
603 else if (op == MATCH || op == NOMATCH) {
604 char *s;
605 regexp *pat, *getpat();
606
607 s = getsval(u);
608 pat = getpat(v);
609 i = match(pat, s) == 0 ? 0 : 1;
610 if (op == NOMATCH)
611 i = i == 0 ? 1 : 0;
612 }
613 else { /* relative operator */
614/*
615printf("Cond(%d)(%d)(%s)(%s)\n", u->c_type, v->c_type, u->c_sval, v->c_sval);
616*/
617 if ((u->c_type & NUM) && (v->c_type & NUM))
618 i = x < y ? -1 : (x > y ? 1 : 0);
619 else
620 i = strcmp(getsval(u), getsval(v));
621/*
622printf("Cond(%d)(%d)(%g)(%g)(%d)\n", u->c_type, v->c_type, x, y, i);
623*/
624
625 switch (op) {
626 case LT: i = i < 0 ? 1 : 0; break;
627 case LE: i = i <= 0 ? 1 : 0; break;
628 case EQ: i = i == 0 ? 1 : 0; break;
629 case NE: i = i != 0 ? 1 : 0; break;
630 case GT: i = i > 0 ? 1 : 0; break;
631 case GE: i = i >= 0 ? 1 : 0; break;
632 default:
633 fprintf(stderr, "unknown relative operator (%d)\n", op);
634 break;
635 }
636 }
637 c_free(v);
638 }
639 c_free(u);
640 pateval = save;
641 return mktmp(NUM, NULL, (double) i);
642}
643
644static CELL *
645If(p) NODE *p;
646{
647 CELL *u;
648 int i;
649 char *s;
650
651 u = execute(p->n_arg[0]);
652 if (u->c_type & NUM)
653 i = (getfval(u) != 0.0);
654 else {
655 s = getsval(u);
656 i = (s != (char *)NULL) && (*s != '\0');
657 }
658 c_free(u);
659 if (i)
660 u = execute(p->n_arg[1]);
661 else if (p->n_arg[2])
662 u = execute(p->n_arg[2]);
663 else
664 u = &truecell;
665 return u;
666}
667
668static CELL *
669While(p) NODE *p;
670{
671 CELL *u;
672 double x;
673
674 for (;;) {
675 u = execute(p->n_arg[0]);
676 x = getfval(u);
677 if (x == 0.0)
678 break;
679 c_free(u);
680 u = execute(p->n_arg[1]);
681 switch (u->c_type) {
682 case BRK:
683 goto rtn;
684 case NXT: case EXT: case RTN:
685 return u;
686 }
687 c_free(u);
688 }
689rtn:
690 c_free(u);
691 return &truecell;
692}
693
694static CELL *
695Do(p) NODE *p;
696{
697 CELL *u;
698 double x;
699
700 for (;;) {
701 u = execute(p->n_arg[0]);
702 switch (u->c_type) {
703 case BRK:
704 goto rtn;
705 case NXT: case EXT: case RTN:
706 return u;
707 }
708 c_free(u);
709 u = execute(p->n_arg[1]);
710 if(getfval(u) == 0.0)
711 break;
712 c_free(u);
713 }
714rtn:
715 c_free(u);
716 return &truecell;
717}
718
719static CELL *
720For(p) NODE *p;
721{
722 CELL *u;
723 double x;
724
725 if (p->n_arg[0] != NULL) {
726 u = execute(p->n_arg[0]);
727 c_free(u);
728 }
729 for (;;) {
730 if (p->n_arg[1] != NULL) {
731 u = execute(p->n_arg[1]);
732 x = getfval(u);
733 c_free(u);
734 if (x == 0.0)
735 break;
736 }
737 u = execute(p->n_arg[3]);
738 switch (u->c_type) {
739 case BRK:
740 c_free(u);
741 goto rtn;
742 case NXT: case EXT: case RTN:
743 return u;
744 }
745 if (p->n_arg[2] != NULL) {
746 u = execute(p->n_arg[2]);
747 c_free(u);
748 }
749 }
750rtn:
751 return &truecell;
752}
753
754static CELL *
755Jump(p) NODE *p;
756{
757 CELL *u;
758 int i;
759
760 switch ((int) p->n_arg[0]) {
761 case BREAK: u = &breakcell; break;
762 case CONTIN: u = &contcell; break;
763 case EXIT:
764 if ((int) p->n_arg[1]) {
765 u = execute(p->n_arg[1]);
766 i = (int) getfval(u);
767 }
768 else
769 i = 0;
770 closeall();
771 exit(i);
772 case RETURN:
773 Return(p);
774 u = &retcell;
775 break;
776 case NEXT: u = &nextcell; break;
777 }
778 return u;
779}
780
781static
782Return(p) NODE *p;
783{
784 CELL *u;
785 int i;
786 char *s, str[BUFSIZ];
787
788 c_free(retval);
789 if (p->n_arg[1] != NULL) {
790 if (p->n_arg[2] == NULL) {
791/*
792if (0) {
793*/
794 u = execute(p->n_arg[1]);
795 if (u->c_type == UDF)
796 retval = mktmp(STR, "", 0.0);
797 else
798 retval = mktmp(u->c_type, u->c_sval, u->c_fval);
799 c_free(u);
800 }
801 else {
802 for (i = 1; p->n_arg[i] != NULL; i++) {
803 if (i == 1)
804 *str = '\0';
805 else
806 strcat(str, *OFS);
807 u = execute(p->n_arg[i]);
808 s = getsval(u);
809 strcat(str, s);
810 c_free(u);
811 }
812/*
813printf("Ret(%s)(%d)\n", str, isnum(str));
814*/
815 if (isnum(str))
816 retval = mktmp(STR|NUM, str, atof(str));
817 else
818 retval = mktmp(STR, str, 0.0);
819 }
820 }
821 else
822 retval = &truecell;
823}
824
825#define MAXFRAME 100
826CELL **frame[MAXFRAME];
827static int framep;
828
829static CELL *
830Arg(p) NODE *p;
831{
832 CELL *u;
833 int i;
834
835 u = (CELL *)p->n_arg[0];
836 return _Arg((int)u->c_fval);
837}
838
839CELL *
840_Arg(i)
841{
842/*
843printf("Arg(%d)\n", i);
844*/
845 return frame[framep - 1][i];
846}
847
848static CELL *
849Call(p) NODE *p;
850{
851 CELL *u, *v, *r, **arg;
852 NODE *q;
853 int i, j, k, n;
854 char *emalloc();
855
856 if (framep >= MAXFRAME - 2)
857 error("stack frame overflow", (char *)0);
858 retval = &truecell;
859 r = (CELL *) p->n_arg[0];
860 if (r->c_type != FUN)
861 synerr("called function is not declared", (char *)0);
862 n = (int) r->c_fval; /* # of params */
863 if (n > 0) {
864 arg = (CELL **) emalloc(sizeof(u) * n);
865 for (i = 2, j = 0, k = (int) p->n_arg[1]; j < k; i++) {
866 u = execute(p->n_arg[i]);
867/*
868printf("pass, j(%d)typ(%d)\n", j, u->c_type);
869*/
870 if (u->c_type & ARR)
871 v = u; /* pass by reference */
872 else { /* pass by value */
873 v = mkcell(UDF, u->c_sval, u->c_fval);
874 if (u->c_type != UDF) {
875#if 0
876 v->c_type = u->c_type;
877 if (v->c_type & (NUM|STR))
878 v->c_type |= VAR;
879 v->c_type &= ~TMP; /* dont't free */
880#else
881 v->c_type |= (u->c_type & (NUM|STR))|VAR;
882 /*v->c_type &= ~TMP;*/
883#endif
884 /* Don't free original */
885 }
886/*
887printf("pass1, j(%d)typ(%d)\n", j, v->c_type);
888*/
889 }
890 arg[j++] = v;
891 }
892 for ( ; j < n; ) /* local var */
893 arg[j++] = mkcell(UDF, NULL, 0.0);
894 }
895 else
896 arg = NULL;
897
898 frame[framep] = arg;
899 framep++;
900
901 r = execute(r->c_sval);
902 c_free(r);
903 framep--;
904 if (n > 0) {
905 for (j = n - 1 ; j > k; j--) { /* local var */
906 u = arg[j];
907 if (u->c_type & ARR)
908 a_free(u);
909 else
910 c_free(u);
911 }
912 for ( ; j >= 0; j--) {
913 u = arg[j];
914 if (!(u->c_type & ARR)) {
915/* c_free(u);*/
916 sfree(u->c_sval);
917 sfree(u);
918 }
919 else {
920 v = execute(p->n_arg[j + 2]);
921 if (v->c_type == UDF) { /* copy back */
922/*
923printf("copy_back_UDF(%d)(%d)\n", j, u->c_type);
924*/
925 v->c_type = u->c_type;
926 sfree(v->c_sval);
927 v->c_sval = u->c_sval;
928 v->c_fval = u->c_fval;
929 sfree(u);
930 }
931 }
932 }
933 }
934 sfree(arg);
935/* return retval;*/
936 u = mktmp(retval->c_type, retval->c_sval, retval->c_fval);
937 return u;
938}
939
940CELL *Nulproc()
941{
942 return &truecell;
943}
944
945CELL *
946Usrfun(p) NODE *p;
947{
948 CELL *u;
949
950 u = execute(p);
951 return u;
952}
Note: See TracBrowser for help on using the repository browser.