1 rizwank 1.1 /*
2 * General helper utilities.
3 * Copyright (c) 1997-1999 Markku Rossi.
4 *
5 * Author: Markku Rossi <mtr@iki.fi>
6 */
7
8 /*
9 * This file is part of GNU enscript.
10 *
11 * This program is free software; you can redistribute it and/or modify
12 * it under the terms of the GNU General Public License as published by
13 * the Free Software Foundation; either version 2, or (at your option)
14 * any later version.
15 *
16 * This program is distributed in the hope that it will be useful,
17 * but WITHOUT ANY WARRANTY; without even the implied warranty of
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 * GNU General Public License for more details.
20 *
21 * You should have received a copy of the GNU General Public License
22 rizwank 1.1 * along with this program; see the file COPYING. If not, write to
23 * the Free Software Foundation, 59 Temple Place - Suite 330,
24 * Boston, MA 02111-1307, USA.
25 */
26
27 #include "defs.h"
28
29 /*
30 * Static variables.
31 */
32
33 static RE_TRANSLATE_TYPE case_insensitive_translate = NULL;
34
35
36 /*
37 * Global functions.
38 */
39
40 /* Generic linked list. */
41
42 List *
43 rizwank 1.1 list ()
44 {
45 return (List *) xcalloc (1, sizeof (List));
46 }
47
48
49 void
50 list_prepend (list, data)
51 List *list;
52 void *data;
53 {
54 ListItem *item;
55
56 item = (ListItem *) xmalloc (sizeof (*item));
57 item->data = data;
58
59 item->next = list->head;
60 list->head = item;
61
62 if (list->tail == NULL)
63 list->tail = item;
64 rizwank 1.1 }
65
66
67 void
68 list_append (list, data)
69 List *list;
70 void *data;
71 {
72 ListItem *item;
73
74 item = (ListItem *) xcalloc (1, sizeof (*item));
75 item->data = data;
76
77 if (list->tail)
78 list->tail->next = item;
79 else
80 list->head = item;
81 list->tail = item;
82 }
83
84 /*
85 rizwank 1.1 * Node manipulators.
86 */
87
88 Node *
89 node_alloc (type)
90 NodeType type;
91 {
92 Node *n;
93
94 n = (Node *) xcalloc (1, sizeof (*n));
95 n->type = type;
96 n->refcount = 1;
97 n->linenum = linenum;
98 n->filename = yyin_name;
99
100 if (type == nREGEXP)
101 n->u.re.compiled.fastmap = xmalloc (256);
102
103 return n;
104 }
105
106 rizwank 1.1
107 Node *
108 node_copy (n)
109 Node *n;
110 {
111 Node *n2;
112 int i;
113
114 n2 = node_alloc (n->type);
115 n2->linenum = n->linenum;
116 n2->filename = n->filename;
117
118 switch (n->type)
119 {
120 case nVOID:
121 /* All done. */
122 break;
123
124 case nSTRING:
125 n2->u.str.len = n->u.str.len;
126 /* +1 to avoid zero allocation. */
127 rizwank 1.1 n2->u.str.data = (char *) xmalloc (n2->u.str.len + 1);
128 memcpy (n2->u.str.data, n->u.str.data, n->u.str.len);
129 break;
130
131 case nREGEXP:
132 n2->u.re.data = xstrdup (n->u.re.data);
133 n2->u.re.len = n->u.re.len;
134 break;
135
136 case nINTEGER:
137 n2->u.integer = n->u.integer;
138 break;
139
140 case nREAL:
141 n2->u.real = n->u.real;
142 break;
143
144 case nSYMBOL:
145 n2->u.sym = xstrdup (n->u.sym);
146 break;
147
148 rizwank 1.1 case nARRAY:
149 n2->u.array.len = n->u.array.len;
150 n2->u.array.allocated = n2->u.array.len + 1;
151 n2->u.array.array = (Node **) xcalloc (n2->u.array.allocated,
152 sizeof (Node *));
153 for (i = 0; i < n->u.array.len; i++)
154 n2->u.array.array[i] = node_copy (n->u.array.array[i]);
155 break;
156 }
157
158 return n2;
159 }
160
161
162 void
163 node_reference (node)
164 Node *node;
165 {
166 node->refcount++;
167 }
168
169 rizwank 1.1
170 void
171 node_free (node)
172 Node *node;
173 {
174 unsigned int i;
175
176 if (node == NULL)
177 return;
178
179 if (--node->refcount > 0)
180 return;
181
182 /* This was the last reference, free the node. */
183 switch (node->type)
184 {
185 case nVOID:
186 /* There is only nVOID node, do not free it. */
187 return;
188 break;
189
190 rizwank 1.1 case nSTRING:
191 xfree (node->u.str.data);
192 break;
193
194 case nREGEXP:
195 free (node->u.re.data);
196 xfree (node->u.re.compiled.fastmap);
197 break;
198
199 case nINTEGER:
200 case nREAL:
201 case nSYMBOL:
202 /* Nothing here. */
203 break;
204
205 case nARRAY:
206 for (i = 0; i < node->u.array.len; i++)
207 node_free (node->u.array.array[i]);
208
209 xfree (node->u.array.array);
210 break;
211 rizwank 1.1 }
212
213 xfree (node);
214 }
215
216
217 void
218 enter_system_variable (name, value)
219 char *name;
220 char *value;
221 {
222 Node *n, *old_val;
223
224 n = node_alloc (nSTRING);
225 n->u.str.len = strlen (value);
226 n->u.str.data = xstrdup (value);
227 if (!strhash_put (ns_vars, name, strlen (name), n, (void **) &old_val))
228 {
229 fprintf (stderr, _("%s: out of memory\n"), program);
230 exit (1);
231 }
232 rizwank 1.1 node_free (old_val);
233 }
234
235
236 void
237 compile_regexp (re)
238 Node *re;
239 {
240 const char *msg;
241
242 if (case_insensitive_translate == NULL)
243 {
244 int i;
245
246 case_insensitive_translate = xmalloc (256);
247
248 for (i = 0; i < 256; i++)
249 if (isupper (i))
250 case_insensitive_translate[i] = tolower (i);
251 else
252 case_insensitive_translate[i] = i;
253 rizwank 1.1 }
254
255 if (re->u.re.flags & fRE_CASE_INSENSITIVE)
256 re->u.re.compiled.translate = case_insensitive_translate;
257
258 msg = re_compile_pattern (re->u.re.data, re->u.re.len, &re->u.re.compiled);
259 if (msg)
260 {
261 fprintf (stderr,
262 _("%s:%d: couldn't compile regular expression \"%s\": %s\n"),
263 re->filename, re->linenum, re->u.re.data, msg);
264 exit (1);
265 }
266
267 re_compile_fastmap (&re->u.re.compiled);
268 }
269
270
271 /*
272 * Grammar constructors.
273 */
274 rizwank 1.1
275 Stmt *
276 mk_stmt (type, arg1, arg2, arg3, arg4)
277 StmtType type;
278 void *arg1;
279 void *arg2;
280 void *arg3;
281 void *arg4;
282 {
283 Stmt *stmt;
284
285 stmt = (Stmt *) xcalloc (1, sizeof (*stmt));
286 stmt->type = type;
287 stmt->linenum = linenum;
288 stmt->filename = yyin_name;
289
290 switch (type)
291 {
292 case sEXPR:
293 case sRETURN:
294 stmt->u.expr = arg1;
295 rizwank 1.1 break;
296
297 case sDEFSUB:
298 stmt->u.defsub.name = arg1;
299 stmt->u.defsub.closure = arg2;
300 break;
301
302 case sBLOCK:
303 stmt->u.block = arg1; /* Statement list. */
304 break;
305
306 case sIF:
307 stmt->u.stmt_if.expr = arg1;
308 stmt->u.stmt_if.then_stmt = arg2;
309 stmt->u.stmt_if.else_stmt = arg3;
310 break;
311
312 case sWHILE:
313 stmt->u.stmt_while.expr = arg1;
314 stmt->u.stmt_while.body = arg2;
315 break;
316 rizwank 1.1
317 case sFOR:
318 stmt->u.stmt_for.init = arg1;
319 stmt->u.stmt_for.cond = arg2;
320 stmt->u.stmt_for.incr = arg3;
321 stmt->u.stmt_for.body = arg4;
322 break;
323 }
324
325 return stmt;
326 }
327
328
329 Expr *
330 mk_expr (type, arg1, arg2, arg3)
331 ExprType type;
332 void *arg1;
333 void *arg2;
334 void *arg3;
335 {
336 Expr *expr;
337 rizwank 1.1
338 expr = (Expr *) xcalloc (1, sizeof (*expr));
339 expr->type = type;
340 expr->linenum = linenum;
341 expr->filename = yyin_name;
342
343 switch (type)
344 {
345 case eSTRING:
346 case eREGEXP:
347 case eINTEGER:
348 case eREAL:
349 case eSYMBOL:
350 expr->u.node = arg1;
351 break;
352
353 case eNOT:
354 expr->u.not = arg1;
355 break;
356
357 case eFCALL:
358 rizwank 1.1 expr->u.fcall.name = arg1;
359 expr->u.fcall.args = arg2;
360 break;
361
362 case eASSIGN:
363 case eADDASSIGN:
364 case eSUBASSIGN:
365 case eMULASSIGN:
366 case eDIVASSIGN:
367 expr->u.assign.sym = arg1;
368 expr->u.assign.expr = arg2;
369 break;
370
371 case ePOSTFIXADD:
372 case ePOSTFIXSUB:
373 case ePREFIXADD:
374 case ePREFIXSUB:
375 expr->u.node = arg1;
376 break;
377
378 case eARRAYASSIGN:
379 rizwank 1.1 expr->u.arrayassign.expr1 = arg1;
380 expr->u.arrayassign.expr2 = arg2;
381 expr->u.arrayassign.expr3 = arg3;
382 break;
383
384 case eARRAYREF:
385 expr->u.arrayref.expr1 = arg1;
386 expr->u.arrayref.expr2 = arg2;
387 break;
388
389 case eQUESTCOLON:
390 expr->u.questcolon.cond = arg1;
391 expr->u.questcolon.expr1 = arg2;
392 expr->u.questcolon.expr2 = arg3;
393 break;
394
395 case eMULT:
396 case eDIV:
397 case ePLUS:
398 case eMINUS:
399 case eLT:
400 rizwank 1.1 case eGT:
401 case eEQ:
402 case eNE:
403 case eGE:
404 case eLE:
405 case eAND:
406 case eOR:
407 expr->u.op.left = arg1;
408 expr->u.op.right = arg2;
409 break;
410 }
411
412 return expr;
413 }
414
415
416 Cons *
417 cons (car, cdr)
418 void *car;
419 void *cdr;
420 {
421 rizwank 1.1 Cons *c;
422
423 c = (Cons *) xmalloc (sizeof (*c));
424 c->car = car;
425 c->cdr = cdr;
426
427 return c;
428 }
429
430
431 void
432 define_state (sym, super, rules)
433 Node *sym;
434 Node *super;
435 List *rules;
436 {
437 void *old_state;
438 char msg[512];
439 State *state;
440
441 state = (State *) xcalloc (1, sizeof (*state));
442 rizwank 1.1 state->name = xstrdup (sym->u.sym);
443 state->rules = rules;
444
445 if (super)
446 state->super_name = xstrdup (super->u.sym);
447
448 if (!strhash_put (ns_states, sym->u.sym, strlen (sym->u.sym), state,
449 &old_state))
450 {
451 fprintf (stderr, _("%s: ouf of memory"), program);
452 exit (1);
453 }
454 if (old_state)
455 {
456 sprintf (msg, _("warning: redefining state `%s'"), sym->u.sym);
457 yyerror (msg);
458 /* Yes, we leak memory here. */
459 }
460 }
461
462
463 rizwank 1.1 /*
464 * Expression evaluation.
465 */
466
467 static void
468 define_sub (sym, args_body, filename, linenum)
469 Node *sym;
470 Cons *args_body;
471 char *filename;
472 unsigned int linenum;
473 {
474 void *old_data;
475
476 if (!strhash_put (ns_subs, sym->u.sym, strlen (sym->u.sym), args_body,
477 &old_data))
478 {
479 fprintf (stderr, _("%s: ouf of memory"), program);
480 exit (1);
481 }
482 if (old_data && warning_level >= WARN_ALL)
483 fprintf (stderr, _("%s:%d: warning: redefining subroutine `%s'\n"),
484 rizwank 1.1 filename, linenum, sym->u.sym);
485 }
486
487 extern unsigned int current_linenum;
488
489 static Node *
490 lookup_var (env, ns, sym, filename, linenum)
491 Environment *env;
492 StringHashPtr ns;
493 Node *sym;
494 char *filename;
495 unsigned int linenum;
496 {
497 Node *n;
498 Environment *e;
499
500 /* Special variables. */
501 if (sym->u.sym[0] == '$' && sym->u.sym[1] && sym->u.sym[2] == '\0')
502 {
503 /* Regexp sub expression reference. */
504 if (sym->u.sym[1] >= '0' && sym->u.sym[1] <= '9')
505 rizwank 1.1 {
506 int i;
507 int len;
508
509 /* Matched text. */
510 i = sym->u.sym[1] - '0';
511
512 n = node_alloc (nSTRING);
513 if (current_match == NULL || current_match->start[i] < 0
514 || current_match_buf == NULL)
515 {
516 n->u.str.data = (char *) xmalloc (1);
517 n->u.str.len = 0;
518 }
519 else
520 {
521 len = current_match->end[i] - current_match->start[i];
522 n->u.str.data = (char *) xmalloc (len + 1);
523 memcpy (n->u.str.data,
524 current_match_buf + current_match->start[i], len);
525 n->u.str.len = len;
526 rizwank 1.1 }
527
528 /* Must set the refcount to 0 so that the user will free it
529 it when it is not needed anymore. We will never touch
530 this node after this pointer. */
531 n->refcount = 0;
532
533 return n;
534 }
535
536 /* Everything before the matched expression. */
537 if (sym->u.sym[1] == '`' || sym->u.sym[1] == 'B')
538 {
539 n = node_alloc (nSTRING);
540 if (current_match == NULL || current_match->start[0] < 0
541 || current_match_buf == NULL)
542 {
543 n->u.str.data = (char *) xmalloc (1);
544 n->u.str.len = 0;
545 }
546 else
547 rizwank 1.1 {
548 n->u.str.len = current_match->start[0];
549 n->u.str.data = (char *) xmalloc (n->u.str.len + 1);
550 memcpy (n->u.str.data, current_match_buf, n->u.str.len);
551 }
552
553 /* Set the refcount to 0. See above. */
554 n->refcount = 0;
555 return n;
556 }
557
558 /* Current input line number. */
559 if (sym->u.sym[1] == '.')
560 {
561 n = node_alloc (nINTEGER);
562 n->u.integer = current_linenum;
563
564 /* Set the refcount to 0. See above. */
565 n->refcount = 0;
566 return n;
567 }
568 rizwank 1.1 }
569
570 /* Local variables. */
571 for (e = env; e; e = e->next)
572 if (strcmp (e->name, sym->u.sym) == 0)
573 return e->val;
574
575 /* Global variables. */
576 if (strhash_get (ns, sym->u.sym, strlen (sym->u.sym), (void **) &n))
577 return n;
578
579 /* Undefined variable. */
580 fprintf (stderr, _("%s:%d: error: undefined variable `%s'\n"),
581 filename, linenum, sym->u.sym);
582 exit (1);
583
584 /* NOTREACHED */
585 return NULL;
586 }
587
588
589 rizwank 1.1 static void
590 set_var (env, ns, sym, val, filename, linenum)
591 Environment *env;
592 StringHashPtr ns;
593 Node *sym;
594 Node *val;
595 char *filename;
596 unsigned int linenum;
597 {
598 Node *n;
599 Environment *e;
600
601 /* Local variables. */
602 for (e = env; e; e = e->next)
603 if (strcmp (e->name, sym->u.sym) == 0)
604 {
605 node_free (e->val);
606 e->val = val;
607 return;
608 }
609
610 rizwank 1.1 /* Global variables. */
611 if (strhash_put (ns, sym->u.sym, strlen (sym->u.sym), val, (void **) &n))
612 {
613 node_free (n);
614 return;
615 }
616
617 /* Couldn't set value for variable. */
618 fprintf (stderr, _("%s:%d: error: couldn't set variable `%s'\n"),
619 filename, linenum, sym->u.sym);
620 exit (1);
621 /* NOTREACHED */
622 }
623
624
625 static Node *
626 calculate_binary (l, r, type, filename, linenum)
627 Node *l;
628 Node *r;
629 ExprType type;
630 char *filename;
631 rizwank 1.1 unsigned int linenum;
632 {
633 Node *n = NULL;
634
635 switch (type)
636 {
637 case eMULT:
638 case eDIV:
639 case ePLUS:
640 case eMINUS:
641 case eLT:
642 case eGT:
643 case eEQ:
644 case eNE:
645 case eGE:
646 case eLE:
647 if (l->type == r->type && l->type == nINTEGER)
648 {
649 n = node_alloc (nINTEGER);
650 switch (type)
651 {
652 rizwank 1.1 case eMULT:
653 n->u.integer = (l->u.integer * r->u.integer);
654 break;
655
656 case eDIV:
657 n->u.integer = (l->u.integer / r->u.integer);
658 break;
659
660 case ePLUS:
661 n->u.integer = (l->u.integer + r->u.integer);
662 break;
663
664 case eMINUS:
665 n->u.integer = (l->u.integer - r->u.integer);
666 break;
667
668 case eLT:
669 n->u.integer = (l->u.integer < r->u.integer);
670 break;
671
672 case eGT:
673 rizwank 1.1 n->u.integer = (l->u.integer > r->u.integer);
674 break;
675
676 case eEQ:
677 n->u.integer = (l->u.integer == r->u.integer);
678 break;
679
680 case eNE:
681 n->u.integer = (l->u.integer != r->u.integer);
682 break;
683
684 case eGE:
685 n->u.integer = (l->u.integer >= r->u.integer);
686 break;
687
688 case eLE:
689 n->u.integer = (l->u.integer <= r->u.integer);
690 break;
691
692 default:
693 /* NOTREACHED */
694 rizwank 1.1 break;
695 }
696 }
697 else if ((l->type == nINTEGER || l->type == nREAL)
698 && (r->type == nINTEGER || r->type == nREAL))
699 {
700 double dl, dr;
701
702 if (l->type == nINTEGER)
703 dl = (double) l->u.integer;
704 else
705 dl = l->u.real;
706
707 if (r->type == nINTEGER)
708 dr = (double) r->u.integer;
709 else
710 dr = r->u.real;
711
712 n = node_alloc (nREAL);
713 switch (type)
714 {
715 rizwank 1.1 case eMULT:
716 n->u.real = (dl * dr);
717 break;
718
719 case eDIV:
720 n->u.real = (dl / dr);
721 break;
722
723 case ePLUS:
724 n->u.real = (dl + dr);
725 break;
726
727 case eMINUS:
728 n->u.real = (dl - dr);
729 break;
730
731 case eLT:
732 n->type = nINTEGER;
733 n->u.integer = (dl < dr);
734 break;
735
736 rizwank 1.1 case eGT:
737 n->type = nINTEGER;
738 n->u.integer = (dl > dr);
739 break;
740
741 case eEQ:
742 n->type = nINTEGER;
743 n->u.integer = (dl == dr);
744 break;
745
746 case eNE:
747 n->type = nINTEGER;
748 n->u.integer = (dl != dr);
749 break;
750
751 case eGE:
752 n->type = nINTEGER;
753 n->u.integer = (dl >= dr);
754 break;
755
756 case eLE:
757 rizwank 1.1 n->type = nINTEGER;
758 n->u.integer = (dl <= dr);
759 break;
760
761 default:
762 /* NOTREACHED */
763 break;
764 }
765 }
766 else
767 {
768 fprintf (stderr,
769 _("%s:%d: error: expression between illegal types\n"),
770 filename, linenum);
771 exit (1);
772 }
773 break;
774
775 default:
776 /* This is definitely a bug. */
777 abort ();
778 rizwank 1.1 break;
779 }
780
781 return n;
782 }
783
784
785 Node *
786 eval_expr (expr, env)
787 Expr *expr;
788 Environment *env;
789 {
790 Node *n = nvoid;
791 Node *n2;
792 Node *l, *r;
793 Cons *c;
794 Primitive prim;
795 int return_seen;
796 Environment *ei, *ei2;
797 int i;
798 Node sn;
799 rizwank 1.1
800 if (expr == NULL)
801 return nvoid;
802
803 switch (expr->type)
804 {
805 case eSTRING:
806 case eREGEXP:
807 case eINTEGER:
808 case eREAL:
809 node_reference (expr->u.node);
810 return expr->u.node;
811 break;
812
813 case eSYMBOL:
814 n = lookup_var (env, ns_vars, expr->u.node, expr->filename,
815 expr->linenum);
816 node_reference (n);
817 return n;
818 break;
819
820 rizwank 1.1 case eNOT:
821 n = eval_expr (expr->u.not, env);
822 i = !IS_TRUE (n);
823 node_free (n);
824
825 n = node_alloc (nINTEGER);
826 n->u.integer = i;
827 return n;
828 break;
829
830 case eFCALL:
831 n = expr->u.fcall.name;
832 /* User-defined subroutine? */
833 if (strhash_get (ns_subs, n->u.sym, strlen (n->u.sym),
834 (void **) &c))
835 {
836 Environment *nenv = NULL;
837 ListItem *i, *e;
838 List *stmts;
839 List *lst;
840 Cons *args_locals;
841 rizwank 1.1
842 /* Found it, now bind arguments. */
843 args_locals = (Cons *) c->car;
844 stmts = (List *) c->cdr;
845
846 lst = (List *) args_locals->car;
847
848 for (i = lst->head, e = expr->u.fcall.args->head; i && e;
849 i = i->next, e = e->next)
850 {
851 Node *sym;
852
853 sym = (Node *) i->data;
854
855 n = eval_expr ((Expr *) e->data, env);
856
857 ei = (Environment *) xcalloc (1, sizeof (*ei));
858 ei->name = sym->u.sym;
859 ei->val = n;
860 ei->next = nenv;
861 nenv = ei;
862 rizwank 1.1 }
863 /* Check that we had correct amount of arguments. */
864 if (i)
865 {
866 fprintf (stderr,
867 _("%s:%d: error: too few arguments for subroutine\n"),
868 expr->filename, expr->linenum);
869 exit (1);
870 }
871 if (e)
872 {
873 fprintf (stderr,
874 _("%s:%d: error: too many arguments for subroutine\n"),
875 expr->filename, expr->linenum);
876 exit (1);
877 }
878
879 /* Enter local variables. */
880 lst = (List *) args_locals->cdr;
881 for (i = lst->head; i; i = i->next)
882 {
883 rizwank 1.1 Cons *c;
884 Node *sym;
885 Expr *init;
886
887 c = (Cons *) i->data;
888 sym = (Node *) c->car;
889 init = (Expr *) c->cdr;
890
891 ei = (Environment *) xcalloc (1, sizeof (*ei));
892 ei->name = sym->u.sym;
893
894 if (init)
895 ei->val = eval_expr (init, nenv);
896 else
897 ei->val = nvoid;
898
899 ei->next = nenv;
900 nenv = ei;
901 }
902
903 /* Eval statement list. */
904 rizwank 1.1 return_seen = 0;
905 n = eval_statement_list ((List *) c->cdr, nenv, &return_seen);
906
907 /* Cleanup env. */
908 for (ei = nenv; ei; ei = ei2)
909 {
910 ei2 = ei->next;
911 node_free (ei->val);
912 xfree (ei);
913 }
914
915 return n;
916 }
917 /* Primitives. */
918 else if (strhash_get (ns_prims, n->u.sym, strlen (n->u.sym),
919 (void **) &prim))
920 {
921 n = (*prim) (n->u.sym, expr->u.fcall.args, env, expr->filename,
922 expr->linenum);
923 return n;
924 }
925 rizwank 1.1 else
926 {
927 fprintf (stderr,
928 _("%s:%d: error: undefined procedure `%s'\n"),
929 expr->filename, expr->linenum, n->u.sym);
930 exit (1);
931 }
932 break;
933
934 case eASSIGN:
935 n = eval_expr (expr->u.assign.expr, env);
936 set_var (env, ns_vars, expr->u.assign.sym, n, expr->filename,
937 expr->linenum);
938
939 node_reference (n);
940 return n;
941 break;
942
943 case eADDASSIGN:
944 case eSUBASSIGN:
945 case eMULASSIGN:
946 rizwank 1.1 case eDIVASSIGN:
947 n = eval_expr (expr->u.assign.expr, env);
948 n2 = lookup_var (env, ns_vars, expr->u.assign.sym, expr->filename,
949 expr->linenum);
950
951 switch (expr->type)
952 {
953 case eADDASSIGN:
954 n2 = calculate_binary (n2, n, ePLUS, expr->filename, expr->linenum);
955 break;
956
957 case eSUBASSIGN:
958 n2 = calculate_binary (n2, n, eMINUS, expr->filename, expr->linenum);
959 break;
960
961 case eMULASSIGN:
962 n2 = calculate_binary (n2, n, eMULT, expr->filename, expr->linenum);
963 break;
964
965 case eDIVASSIGN:
966 n2 = calculate_binary (n2, n, eDIV, expr->filename, expr->linenum);
967 rizwank 1.1 break;
968
969 default:
970 /* NOTREACHED */
971 abort ();
972 break;
973 }
974 set_var (env, ns_vars, expr->u.assign.sym, n2, expr->filename,
975 expr->linenum);
976
977 node_free (n);
978 node_reference (n2);
979 return n2;
980 break;
981
982 case ePOSTFIXADD:
983 case ePOSTFIXSUB:
984 sn.type = nINTEGER;
985 sn.u.integer = 1;
986
987 n2 = lookup_var (env, ns_vars, expr->u.node, expr->filename,
988 rizwank 1.1 expr->linenum);
989 node_reference (n2);
990
991 n = calculate_binary (n2, &sn,
992 expr->type == ePOSTFIXADD ? ePLUS : eMINUS,
993 expr->filename, expr->linenum);
994 set_var (env, ns_vars, expr->u.node, n, expr->filename, expr->linenum);
995
996 return n2;
997 break;
998
999 case ePREFIXADD:
1000 case ePREFIXSUB:
1001 sn.type = nINTEGER;
1002 sn.u.integer = 1;
1003
1004 n = lookup_var (env, ns_vars, expr->u.node, expr->filename,
1005 expr->linenum);
1006 n = calculate_binary (n, &sn,
1007 expr->type == ePREFIXADD ? ePLUS : eMINUS,
1008 expr->filename, expr->linenum);
1009 rizwank 1.1 set_var (env, ns_vars, expr->u.node, n, expr->filename, expr->linenum);
1010
1011 node_reference (n);
1012 return n;
1013 break;
1014
1015 case eARRAYASSIGN:
1016 n = eval_expr (expr->u.arrayassign.expr1, env);
1017 if (n->type != nARRAY && n->type != nSTRING)
1018 {
1019 fprintf (stderr,
1020 _("%s:%d: error: illegal lvalue for assignment\n"),
1021 expr->filename, expr->linenum);
1022 exit (1);
1023 }
1024 n2 = eval_expr (expr->u.arrayassign.expr2, env);
1025 if (n2->type != nINTEGER)
1026 {
1027 fprintf (stderr,
1028 _("%s:%d: error: array reference index is not integer\n"),
1029 expr->filename, expr->linenum);
1030 rizwank 1.1 exit (1);
1031 }
1032 if (n2->u.integer < 0)
1033 {
1034 fprintf (stderr, _("%s:%d: error: negative array reference index\n"),
1035 expr->filename, expr->linenum);
1036 exit (1);
1037 }
1038
1039 /* Do the assignment. */
1040 if (n->type == nARRAY)
1041 {
1042 if (n2->u.integer >= n->u.array.len)
1043 {
1044 if (n2->u.integer >= n->u.array.allocated)
1045 {
1046 /* Allocate more space. */
1047 n->u.array.allocated = n2->u.integer + 100;
1048 n->u.array.array = (Node **) xrealloc (n->u.array.array,
1049 n->u.array.allocated
1050 * sizeof (Node *));
1051 rizwank 1.1 }
1052 /* Fill the possible gap. */
1053 for (i = n->u.array.len; i <= n2->u.integer; i++)
1054 n->u.array.array[i] = nvoid;
1055
1056 /* Updated expanded array length. */
1057 n->u.array.len = n2->u.integer + 1;
1058 }
1059 node_free (n->u.array.array[n2->u.integer]);
1060
1061 l = eval_expr (expr->u.arrayassign.expr3, env);
1062
1063 /* +1 for the return value. */
1064 node_reference (l);
1065
1066 n->u.array.array[n2->u.integer] = l;
1067 }
1068 else
1069 {
1070 if (n2->u.integer >= n->u.str.len)
1071 {
1072 rizwank 1.1 i = n->u.str.len;
1073 n->u.str.len = n2->u.integer + 1;
1074 n->u.str.data = (char *) xrealloc (n->u.str.data,
1075 n->u.str.len);
1076
1077 /* Init the expanded string with ' ' character. */
1078 for (; i < n->u.str.len; i++)
1079 n->u.str.data[i] = ' ';
1080 }
1081 l = eval_expr (expr->u.arrayassign.expr3, env);
1082 if (l->type != nINTEGER)
1083 {
1084 fprintf (stderr,
1085 _("%s:%d: error: illegal rvalue for string assignment\n"),
1086 expr->filename, expr->linenum);
1087 exit (1);
1088 }
1089
1090 n->u.str.data[n2->u.integer] = l->u.integer;
1091 }
1092
1093 rizwank 1.1 node_free (n);
1094 node_free (n2);
1095
1096 return l;
1097 break;
1098
1099 case eARRAYREF:
1100 n = eval_expr (expr->u.arrayref.expr1, env);
1101 if (n->type != nARRAY && n->type != nSTRING)
1102 {
1103 fprintf (stderr,
1104 _("%s:%d: error: illegal type for array reference\n"),
1105 expr->filename, expr->linenum);
1106 exit (1);
1107 }
1108 n2 = eval_expr (expr->u.arrayref.expr2, env);
1109 if (n2->type != nINTEGER)
1110 {
1111 fprintf (stderr,
1112 _("%s:%d: error: array reference index is not integer\n"),
1113 expr->filename, expr->linenum);
1114 rizwank 1.1 exit (1);
1115 }
1116 if (n2->u.integer < 0
1117 || (n->type == nARRAY && n2->u.integer >= n->u.array.len)
1118 || (n->type == nSTRING && n2->u.integer >= n->u.str.len))
1119 {
1120 fprintf (stderr,
1121 _("%s:%d: error: array reference index out of rance\n"),
1122 expr->filename, expr->linenum);
1123 exit (1);
1124 }
1125
1126 /* Do the reference. */
1127 if (n->type == nARRAY)
1128 {
1129 l = n->u.array.array[n2->u.integer];
1130 node_reference (l);
1131 }
1132 else
1133 {
1134 l = node_alloc (nINTEGER);
1135 rizwank 1.1 l->u.integer
1136 = (int) ((unsigned char *) n->u.str.data)[n2->u.integer];
1137 }
1138 node_free (n);
1139 node_free (n2);
1140 return l;
1141 break;
1142
1143 case eQUESTCOLON:
1144 n = eval_expr (expr->u.questcolon.cond, env);
1145 i = IS_TRUE (n);
1146 node_free (n);
1147
1148 if (i)
1149 n = eval_expr (expr->u.questcolon.expr1, env);
1150 else
1151 n = eval_expr (expr->u.questcolon.expr2, env);
1152
1153 return n;
1154 break;
1155
1156 rizwank 1.1 case eAND:
1157 n = eval_expr (expr->u.op.left, env);
1158 if (!IS_TRUE (n))
1159 return n;
1160 node_free (n);
1161 return eval_expr (expr->u.op.right, env);
1162 break;
1163
1164 case eOR:
1165 n = eval_expr (expr->u.op.left, env);
1166 if (IS_TRUE (n))
1167 return n;
1168 node_free (n);
1169 return eval_expr (expr->u.op.right, env);
1170 break;
1171
1172 /* Arithmetics. */
1173 case eMULT:
1174 case eDIV:
1175 case ePLUS:
1176 case eMINUS:
1177 rizwank 1.1 case eLT:
1178 case eGT:
1179 case eEQ:
1180 case eNE:
1181 case eGE:
1182 case eLE:
1183 /* Eval sub-expressions. */
1184 l = eval_expr (expr->u.op.left, env);
1185 r = eval_expr (expr->u.op.right, env);
1186
1187 n = calculate_binary (l, r, expr->type, expr->filename, expr->linenum);
1188
1189 node_free (l);
1190 node_free (r);
1191 return n;
1192 break;
1193 }
1194
1195 /* NOTREACHED */
1196 return n;
1197 }
1198 rizwank 1.1
1199
1200 Node *
1201 eval_statement (stmt, env, return_seen)
1202 Stmt *stmt;
1203 Environment *env;
1204 int *return_seen;
1205 {
1206 Node *n = nvoid;
1207 Node *n2;
1208 int i;
1209
1210 switch (stmt->type)
1211 {
1212 case sRETURN:
1213 n = eval_expr (stmt->u.expr, env);
1214 *return_seen = 1;
1215 break;
1216
1217 case sDEFSUB:
1218 define_sub (stmt->u.defsub.name, stmt->u.defsub.closure,
1219 rizwank 1.1 stmt->filename, stmt->linenum);
1220 break;
1221
1222 case sBLOCK:
1223 n = eval_statement_list (stmt->u.block, env, return_seen);
1224 break;
1225
1226 case sIF:
1227 n = eval_expr (stmt->u.stmt_if.expr, env);
1228 i = IS_TRUE (n);
1229 node_free (n);
1230
1231 if (i)
1232 /* Then branch. */
1233 n = eval_statement (stmt->u.stmt_if.then_stmt, env, return_seen);
1234 else
1235 {
1236 /* Optional else branch. */
1237 if (stmt->u.stmt_if.else_stmt)
1238 n = eval_statement (stmt->u.stmt_if.else_stmt, env, return_seen);
1239 else
1240 rizwank 1.1 n = nvoid;
1241 }
1242 break;
1243
1244 case sWHILE:
1245 while (1)
1246 {
1247 n2 = eval_expr (stmt->u.stmt_while.expr, env);
1248 i = IS_TRUE (n2);
1249 node_free (n2);
1250
1251 if (!i)
1252 break;
1253
1254 node_free (n);
1255
1256 /* Eval body. */
1257 n = eval_statement (stmt->u.stmt_while.body, env, return_seen);
1258 if (*return_seen)
1259 break;
1260 }
1261 rizwank 1.1 break;
1262
1263 case sFOR:
1264 /* Init. */
1265 if (stmt->u.stmt_for.init)
1266 {
1267 n2 = eval_expr (stmt->u.stmt_for.init, env);
1268 node_free (n2);
1269 }
1270
1271 /* Body. */
1272 while (1)
1273 {
1274 n2 = eval_expr (stmt->u.stmt_for.cond, env);
1275 i = IS_TRUE (n2);
1276 node_free (n2);
1277
1278 if (!i)
1279 break;
1280
1281 node_free (n);
1282 rizwank 1.1
1283 /* Eval body. */
1284 n = eval_statement (stmt->u.stmt_for.body, env, return_seen);
1285 if (*return_seen)
1286 break;
1287
1288 /* Increment. */
1289 if (stmt->u.stmt_for.incr)
1290 {
1291 n2 = eval_expr (stmt->u.stmt_for.incr, env);
1292 node_free (n2);
1293 }
1294 }
1295 break;
1296
1297 case sEXPR:
1298 n = eval_expr (stmt->u.expr, env);
1299 break;
1300 }
1301
1302 return n;
1303 rizwank 1.1 }
1304
1305
1306 Node *
1307 eval_statement_list (lst, env, return_seen)
1308 List *lst;
1309 Environment *env;
1310 int *return_seen;
1311 {
1312 ListItem *i;
1313 Stmt *stmt;
1314 Node *n = nvoid;
1315
1316 if (lst == NULL)
1317 return nvoid;
1318
1319 for (i = lst->head; i; i = i->next)
1320 {
1321 node_free (n);
1322
1323 stmt = (Stmt *) i->data;
1324 rizwank 1.1
1325 n = eval_statement (stmt, env, return_seen);
1326 if (*return_seen)
1327 return n;
1328 }
1329
1330 return n;
1331 }
1332
1333
1334 void
1335 load_states_file (name)
1336 char *name;
1337 {
1338 Node *n;
1339 int return_seen = 0;
1340
1341 yyin_name = xstrdup (name);
1342 linenum = 1;
1343
1344 yyin = fopen (yyin_name, "r");
1345 rizwank 1.1 if (yyin == NULL)
1346 {
1347 fprintf (stderr, _("%s: couldn't open definition file `%s': %s\n"),
1348 program, yyin_name, strerror (errno));
1349 exit (1);
1350 }
1351
1352
1353 yyparse ();
1354 fclose (yyin);
1355
1356 /* Evaluate all top-level statements. */
1357 n = eval_statement_list (global_stmts, NULL, &return_seen);
1358 node_free (n);
1359
1360 /* Reset the global statements to an empty list. */
1361 global_stmts = list ();
1362 }
1363
1364
1365 int
1366 rizwank 1.1 autoload_file (name)
1367 char *name;
1368 {
1369 char *start;
1370 unsigned int len;
1371 char *cp;
1372 char *buf = NULL;
1373 unsigned int buflen = 1024;
1374 unsigned int name_len;
1375 struct stat stat_st;
1376 int result = 0;
1377
1378 name_len = strlen (name);
1379 buf = xmalloc (buflen);
1380
1381 for (start = path; start; start = cp)
1382 {
1383 cp = strchr (start, PATH_SEPARATOR);
1384 if (cp)
1385 {
1386 len = cp - start;
1387 rizwank 1.1 cp++;
1388 }
1389 else
1390 len = strlen (start);
1391
1392 if (len + 1 + name_len + 3 + 1 >= buflen)
1393 {
1394 buflen = len + 1 + name_len + 3 + 1 + 1024;
1395 buf = xrealloc (buf, buflen);
1396 }
1397 sprintf (buf, "%.*s/%s.st", len, start, name);
1398
1399 if (stat (buf, &stat_st) == 0)
1400 {
1401 if (verbose)
1402 fprintf (stderr,
1403 _("%s: autoloading `%s' from `%s'\n"),
1404 program, name, buf);
1405 load_states_file (buf);
1406 result = 1;
1407 break;
1408 rizwank 1.1 }
1409 }
1410
1411 xfree (buf);
1412
1413 return result;
1414 }
1415
1416
1417 State *
1418 lookup_state (name)
1419 char *name;
1420 {
1421 State *state;
1422 int retry_count = 0;
1423
1424 while (1)
1425 {
1426 if (strhash_get (ns_states, name, strlen (name), (void **) &state))
1427 return state;
1428
1429 rizwank 1.1 if (retry_count > 0)
1430 break;
1431
1432 /* Try to autoload the state. */
1433 autoload_file (name);
1434 retry_count++;
1435 }
1436
1437 /* No luck. */
1438 return NULL;
1439 }
|