1 /*
2 * This file is part of DGD, https://github.com/dworkin/dgd
3 * Copyright (C) 1993-2010 Dworkin B.V.
4 * Copyright (C) 2010-2013 DGD Authors (see the commit log for details)
5 *
6 * This program is free software: you can redistribute it and/or modify
7 * it under the terms of the GNU Affero General Public License as
8 * published by the Free Software Foundation, either version 3 of the
9 * License, or (at your option) any later version.
10 *
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 * GNU Affero General Public License for more details.
15 *
16 * You should have received a copy of the GNU Affero General Public License
17 * along with this program. If not, see <http://www.gnu.org/licenses/>.
18 */
19
20 # include "comp.h"
21 # include "str.h"
22 # include "array.h"
23 # include "object.h"
24 # include "xfloat.h"
25 # include "interpret.h"
26 # include "data.h"
27 # include "path.h"
28 # include "macro.h"
29 # include "token.h"
30 # include "ppcontrol.h"
31 # include "node.h"
32 # include "control.h"
33 # include "optimize.h"
34 # include "codegen.h"
35 # include "compile.h"
36 # include <stdarg.h>
37
38 # define COND_CHUNK 16
39 # define COND_BMAP BMAP(MAX_LOCALS)
40
41 typedef struct _cond_ {
42 struct _cond_ *prev; /* surrounding conditional */
43 Uint init[COND_BMAP]; /* initialize variable bitmap */
44 } cond;
45
46 typedef struct _cchunk_ {
47 struct _cchunk_ *next; /* next in cond chunk list */
48 cond c[COND_CHUNK]; /* chunk of conds */
49 } cchunk;
50
51 # define BLOCK_CHUNK 16
52
53 typedef struct _block_ {
54 int vindex; /* variable index */
55 int nvars; /* # variables in this block */
56 struct _block_ *prev; /* surrounding block */
57 } block;
58
59 typedef struct _bchunk_ {
60 struct _bchunk_ *next; /* next in block chunk list */
61 block b[BLOCK_CHUNK]; /* chunk of blocks */
62 } bchunk;
63
64 typedef struct {
65 char *name; /* variable name */
66 short type; /* variable type */
67 short unset; /* used before set? */
68 string *cvstr; /* class name */
69 } var;
70
71 static cchunk *clist; /* list of all cond chunks */
72 static cond *fclist; /* list of free conditions */
73 static cond *thiscond; /* current condition */
74 static int cchunksz = COND_CHUNK; /* size of current cond chunk */
75 static bchunk *blist; /* list of all block chunks */
76 static block *fblist; /* list of free statement blocks */
77 static block *thisblock; /* current statement block */
78 static int bchunksz = BLOCK_CHUNK; /* size of current block chunk */
79 static int vindex; /* variable index */
80 static int nvars; /* number of local variables */
81 static int nparams; /* number of parameters */
82 static var variables[MAX_LOCALS]; /* variables */
83
84 /*
85 * NAME: cond->new()
86 * DESCRIPTION: create a new condition
87 */
cond_new(cond * c2)88 static void cond_new(cond *c2)
89 {
90 cond *c;
91
92 if (fclist != (cond *) NULL) {
93 c = fclist;
94 fclist = c->prev;
95 } else {
96 if (cchunksz == COND_CHUNK) {
97 cchunk *cc;
98
99 cc = ALLOC(cchunk, 1);
100 cc->next = clist;
101 clist = cc;
102 cchunksz = 0;
103 }
104 c = &clist->c[cchunksz++];
105 }
106 c->prev = thiscond;
107 if (c2 != (cond *) NULL) {
108 memcpy(c->init, c2->init, COND_BMAP * sizeof(Uint));
109 } else {
110 memset(c->init, '\0', COND_BMAP * sizeof(Uint));
111 }
112 thiscond = c;
113 }
114
115 /*
116 * NAME: cond->del()
117 * DESCRIPTION: delete the current condition
118 */
cond_del()119 static void cond_del()
120 {
121 cond *c;
122
123 c = thiscond;
124 thiscond = c->prev;
125 c->prev = fclist;
126 fclist = c;
127 }
128
129 /*
130 * NAME: cond->match()
131 * DESCRIPTION: match two init bitmaps
132 */
cond_match(cond * c1,cond * c2,cond * c3)133 static void cond_match(cond *c1, cond *c2, cond *c3)
134 {
135 Uint *p, *q, *r;
136 int i;
137
138 p = c1->init;
139 q = c2->init;
140 r = c3->init;
141 for (i = COND_BMAP; i > 0; --i) {
142 *p++ = *q++ & *r++;
143 }
144 }
145
146 /*
147 * NAME: cond->clear()
148 * DESCRIPTION: clean up conditions
149 */
cond_clear()150 static void cond_clear()
151 {
152 cchunk *c;
153
154 for (c = clist; c != (cchunk *) NULL; ) {
155 cchunk *f;
156
157 f = c;
158 c = c->next;
159 FREE(f);
160 }
161 clist = (cchunk *) NULL;
162 fclist = (cond *) NULL;
163 thiscond = (cond *) NULL;
164 cchunksz = COND_CHUNK;
165 }
166
167 /*
168 * NAME: block->new()
169 * DESCRIPTION: start a new block
170 */
block_new()171 static void block_new()
172 {
173 block *b;
174
175 if (fblist != (block *) NULL) {
176 b = fblist;
177 fblist = b->prev;
178 } else {
179 if (bchunksz == BLOCK_CHUNK) {
180 bchunk *l;
181
182 l = ALLOC(bchunk, 1);
183 l->next = blist;
184 blist = l;
185 bchunksz = 0;
186 }
187 b = &blist->b[bchunksz++];
188 }
189 if (thisblock == (block *) NULL) {
190 cond_new((cond *) NULL);
191 b->vindex = 0;
192 b->nvars = nparams;
193 } else {
194 b->vindex = vindex;
195 b->nvars = 0;
196 }
197 b->prev = thisblock;
198 thisblock = b;
199 }
200
201 /*
202 * NAME: block->del()
203 * DESCRIPTION: finish the current block
204 */
block_del(bool keep)205 static void block_del(bool keep)
206 {
207 block *f;
208 int i;
209
210 f = thisblock;
211 if (keep) {
212 for (i = f->vindex; i < f->vindex + f->nvars; i++) {
213 /*
214 * Make sure that variables declared in the closing block can no
215 * longer be used.
216 */
217 variables[i].name = "-";
218 }
219 } else {
220 vindex = f->vindex;
221 }
222 thisblock = f->prev;
223 if (thisblock == (block *) NULL) {
224 cond_del();
225 }
226 f->prev = fblist;
227 fblist = f;
228 }
229
230 /*
231 * NAME: block->var()
232 * DESCRIPTION: return the index of the local var if found, or -1
233 */
block_var(char * name)234 static int block_var(char *name)
235 {
236 int i;
237
238 for (i = vindex; i > 0; ) {
239 if (strcmp(variables[--i].name, name) == 0) {
240 return i;
241 }
242 }
243 return -1;
244 }
245
246 /*
247 * NAME: block->pdef()
248 * DESCRIPTION: declare a function parameter
249 */
block_pdef(char * name,short type,string * cvstr)250 static void block_pdef(char *name, short type, string *cvstr)
251 {
252 if (block_var(name) >= 0) {
253 c_error("redeclaration of parameter %s", name);
254 } else {
255 /* "too many parameters" is checked for elsewhere */
256 variables[nparams].name = name;
257 variables[nparams].type = type;
258 variables[nparams].unset = 0;
259 variables[nparams++].cvstr = cvstr;
260 vindex++;
261 nvars++;
262 }
263 }
264
265 /*
266 * NAME: block->vdef()
267 * DESCRIPTION: declare a local variable
268 */
block_vdef(char * name,short type,string * cvstr)269 static void block_vdef(char *name, short type, string *cvstr)
270 {
271 if (block_var(name) >= thisblock->vindex) {
272 c_error("redeclaration of local variable %s", name);
273 } else if (vindex == MAX_LOCALS) {
274 c_error("too many local variables");
275 } else {
276 BCLR(thiscond->init, vindex);
277 thisblock->nvars++;
278 variables[vindex].name = name;
279 variables[vindex].type = type;
280 variables[vindex].unset = 0;
281 variables[vindex++].cvstr = cvstr;
282 if (vindex > nvars) {
283 nvars++;
284 }
285 }
286 }
287
288 /*
289 * NAME: block->clear()
290 * DESCRIPTION: clean up blocks
291 */
block_clear()292 static void block_clear()
293 {
294 bchunk *l;
295
296 for (l = blist; l != (bchunk *) NULL; ) {
297 bchunk *f;
298
299 f = l;
300 l = l->next;
301 FREE(f);
302 }
303 blist = (bchunk *) NULL;
304 bchunksz = BLOCK_CHUNK;
305 fblist = (block *) NULL;
306 thisblock = (block *) NULL;
307 vindex = 0;
308 nvars = 0;
309 nparams = 0;
310 }
311
312
313 # define LOOP_CHUNK 16
314
315 typedef struct _loop_ {
316 char type; /* case label type */
317 bool brk; /* seen any breaks? */
318 bool cont; /* seen any continues? */
319 bool dflt; /* seen any default labels? */
320 Uint ncase; /* number of case labels */
321 unsigned short nesting; /* rlimits/catch nesting level */
322 node *case_list; /* previous list of case nodes */
323 node *vlist; /* variable list */
324 struct _loop_ *prev; /* previous loop or switch */
325 struct _loop_ *env; /* enclosing loop */
326 } loop;
327
328 typedef struct _lchunk_ {
329 struct _lchunk_ *next; /* next in loop chunk list */
330 loop l[LOOP_CHUNK]; /* chunk of loops */
331 } lchunk;
332
333 static lchunk *llist; /* list of all loop chunks */
334 static loop *fllist; /* list of free loops */
335 static int lchunksz = LOOP_CHUNK; /* size of current loop chunk */
336 static unsigned short nesting; /* current rlimits/catch nesting level */
337
338 /*
339 * NAME: loop->new()
340 * DESCRIPTION: create a new loop
341 */
loop_new(loop * prev)342 static loop *loop_new(loop *prev)
343 {
344 loop *l;
345
346 if (fllist != (loop *) NULL) {
347 l = fllist;
348 fllist = l->prev;
349 } else {
350 if (lchunksz == LOOP_CHUNK) {
351 lchunk *lc;
352
353 lc = ALLOC(lchunk, 1);
354 lc->next = llist;
355 llist = lc;
356 lchunksz = 0;
357 }
358 l = &llist->l[lchunksz++];
359 }
360 l->brk = FALSE;
361 l->cont = FALSE;
362 l->nesting = nesting;
363 l->prev = prev;
364 return l;
365 }
366
367 /*
368 * NAME: loop->del()
369 * DESCRIPTION: delete a loop
370 */
loop_del(loop * l)371 static loop *loop_del(loop *l)
372 {
373 loop *f;
374
375 f = l;
376 l = l->prev;
377 f->prev = fllist;
378 fllist = f;
379 return l;
380 }
381
382 /*
383 * NAME: loop->clear()
384 * DESCRIPTION: delete all loops
385 */
loop_clear()386 static void loop_clear()
387 {
388 lchunk *l;
389
390 for (l = llist; l != (lchunk *) NULL; ) {
391 lchunk *f;
392
393 f = l;
394 l = l->next;
395 FREE(f);
396 }
397 llist = (lchunk *) NULL;
398 lchunksz = LOOP_CHUNK;
399 fllist = (loop *) NULL;
400 }
401
402
403 typedef struct _context_ {
404 char *file; /* file to compile */
405 frame *frame; /* current interpreter stack frame */
406 struct _context_ *prev; /* previous context */
407 } context;
408
409 static context *current; /* current context */
410 static char *auto_object; /* auto object */
411 static char *driver_object; /* driver object */
412 static char *include; /* standard include file */
413 static char **paths; /* include paths */
414 static bool stricttc; /* strict typechecking */
415 static bool typechecking; /* is current function typechecked? */
416 static bool seen_decls; /* seen any declarations yet? */
417 static short ftype; /* current function type & class */
418 static string *fclass; /* function class string */
419 static loop *thisloop; /* current loop */
420 static loop *switch_list; /* list of nested switches */
421 static node *case_list; /* list of case labels */
422 extern int nerrors; /* # of errors during parsing */
423
424 /*
425 * NAME: compile->init()
426 * DESCRIPTION: initialize the compiler
427 */
c_init(char * a,char * d,char * i,char ** p,int tc)428 void c_init(char *a, char *d, char *i, char **p, int tc)
429 {
430 stricttc = (tc == 2);
431 node_init(stricttc);
432 opt_init();
433 auto_object = a;
434 driver_object = d;
435 include = i;
436 paths = p;
437 typechecking = tc | cg_compiled();
438 }
439
440 /*
441 * NAME: compile->clear()
442 * DESCRIPTION: clean up the compiler
443 */
c_clear()444 static void c_clear()
445 {
446 cg_clear();
447 loop_clear();
448 thisloop = (loop *) NULL;
449 switch_list = (loop *) NULL;
450 block_clear();
451 cond_clear();
452 node_clear();
453 seen_decls = FALSE;
454 nesting = 0;
455 }
456
457 /*
458 * NAME: compile->typechecking()
459 * DESCRIPTION: return the global typechecking flag
460 */
c_typechecking()461 bool c_typechecking()
462 {
463 return typechecking;
464 }
465
466 static long ncompiled; /* # objects compiled */
467
468 /*
469 * NAME: compile->inherit()
470 * DESCRIPTION: Inherit an object in the object currently being compiled.
471 * Return TRUE if compilation can continue, or FALSE otherwise.
472 */
c_inherit(char * file,node * label,int priv)473 bool c_inherit(char *file, node *label, int priv)
474 {
475 char buf[STRINGSZ];
476 object *obj;
477 frame *f;
478 long ncomp;
479
480 obj = NULL;
481
482 if (strcmp(current->file, auto_object) == 0) {
483 c_error("cannot inherit from auto object");
484 return FALSE;
485 }
486
487 f = current->frame;
488 if (strcmp(current->file, driver_object) == 0) {
489 /*
490 * the driver object can only inherit the auto object
491 */
492 file = path_resolve(buf, file);
493 if (!strcmp(file, auto_object) == 0) {
494 c_error("illegal inherit from driver object");
495 return FALSE;
496 }
497 obj = o_find(file, OACC_READ);
498 if (obj == (object *) NULL) {
499 obj = c_compile(f, file, (object *) NULL, (string **) NULL, 0,
500 TRUE);
501 return FALSE;
502 }
503 } else {
504 ncomp = ncompiled;
505
506 /* get associated object */
507 PUSH_STRVAL(f, str_new(NULL, strlen(current->file) + 1L));
508 f->sp->u.string->text[0] = '/';
509 strcpy(f->sp->u.string->text + 1, current->file);
510 PUSH_STRVAL(f, str_new(file, (long) strlen(file)));
511 PUSH_INTVAL(f, priv);
512
513 strncpy(buf, file, STRINGSZ - 1);
514 buf[STRINGSZ - 1] = '\0';
515 if (call_driver_object(f, "inherit_program", 3)) {
516 if (f->sp->type == T_OBJECT) {
517 obj = OBJR(f->sp->oindex);
518 f->sp++;
519 } else {
520 /* returned value not an object */
521 error("Cannot inherit \"%s\"", buf);
522 }
523
524 if (ncomp != ncompiled) {
525 return FALSE; /* objects compiled inside inherit_program() */
526 }
527 } else {
528 /* precompiling */
529 f->sp++;
530 file = path_from(buf, current->file, file);
531 obj = o_find(file, OACC_READ);
532 if (obj == (object *) NULL) {
533 obj = c_compile(f, file, (object *) NULL, (string **) NULL, 0,
534 TRUE);
535 return FALSE;
536 }
537 }
538 }
539
540 if (obj->flags & O_DRIVER) {
541 /* would mess up too many things */
542 c_error("illegal to inherit driver object");
543 return FALSE;
544 }
545
546 return ctrl_inherit(current->frame, current->file, obj,
547 (label == (node *) NULL) ?
548 (string *) NULL : label->l.string,
549 priv);
550 }
551
552 extern int yyparse (void);
553
554 /*
555 * NAME: compile->compile()
556 * DESCRIPTION: compile an LPC file
557 */
c_compile(frame * f,char * file,object * obj,string ** strs,int nstr,int iflag)558 object *c_compile(frame *f, char *file, object *obj, string **strs,
559 int nstr, int iflag)
560 {
561 context c;
562 char file_c[STRINGSZ + 2];
563
564 if (iflag) {
565 context *cc;
566 int n;
567
568 for (cc = current, n = 0; cc != (context *) NULL; cc = cc->prev, n++) {
569 if (strcmp(file, cc->file) == 0) {
570 error("Cycle in inheritance from \"/%s.c\"", current->file);
571 }
572 }
573 if (n >= 255) {
574 error("Compilation nesting too deep");
575 }
576
577 pp_clear();
578 ctrl_clear();
579 c_clear();
580 } else if (current != (context *) NULL) {
581 error("Compilation within compilation");
582 }
583
584 c.file = file;
585 if (strncmp(file, BIPREFIX, BIPREFIXLEN) == 0 ||
586 strchr(file, '#') != (char *) NULL) {
587 error("Illegal object name \"/%s\"", file);
588 }
589 strcpy(file_c, file);
590 if (strs == (string **) NULL) {
591 strcat(file_c, ".c");
592 }
593 c.frame = f;
594 c.prev = current;
595 current = &c;
596 ncompiled++;
597
598 if (ec_push((ec_ftn) NULL)) {
599 pp_clear();
600 ctrl_clear();
601 c_clear();
602 current = c.prev;
603 error((char *) NULL);
604 }
605
606 for (;;) {
607 if (c_autodriver() != 0) {
608 ctrl_init();
609 } else {
610 object *aobj;
611
612 if (!cg_compiled() &&
613 o_find(driver_object, OACC_READ) == (object *) NULL) {
614 /*
615 * compile the driver object to do pathname translation
616 */
617 current = (context *) NULL;
618 c_compile(f, driver_object, (object *) NULL, (string **) NULL,
619 0, FALSE);
620 current = &c;
621 }
622
623 aobj = o_find(auto_object, OACC_READ);
624 if (aobj == (object *) NULL) {
625 /*
626 * compile auto object
627 */
628 aobj = c_compile(f, auto_object, (object *) NULL,
629 (string **) NULL, 0, TRUE);
630 }
631 /* inherit auto object */
632 if (O_UPGRADING(aobj)) {
633 error("Upgraded auto object while compiling \"/%s\"", file_c);
634 }
635 ctrl_init();
636 ctrl_inherit(c.frame, file, aobj, (string *) NULL, FALSE);
637 }
638
639 if (strs != (string **) NULL) {
640 pp_init(file_c, paths, strs, nstr, 1);
641 } else if (!pp_init(file_c, paths, (string **) NULL, 0, 1)) {
642 error("Could not compile \"/%s\"", file_c);
643 }
644 if (!tk_include(include, (string **) NULL, 0)) {
645 error("Could not include \"/%s\"", include);
646 }
647
648 cg_init(c.prev != (context *) NULL);
649 if (yyparse() == 0 && ctrl_chkfuncs()) {
650 control *ctrl;
651
652 if (obj != (object *) NULL) {
653 if (obj->count == 0) {
654 error("Object destructed during recompilation");
655 }
656 if (O_UPGRADING(obj)) {
657 error("Object recompiled during recompilation");
658 }
659 if (O_INHERITED(obj)) {
660 /* inherited */
661 error("Object inherited during recompilation");
662 }
663 }
664 if (!o_space()) {
665 error("Too many objects");
666 }
667
668 /*
669 * successfully compiled
670 */
671 ec_pop();
672 pp_clear();
673
674 if (!seen_decls) {
675 /*
676 * object with inherit statements only (or nothing at all)
677 */
678 ctrl_create();
679 }
680 ctrl = ctrl_construct();
681 ctrl_clear();
682 c_clear();
683 current = c.prev;
684
685 if (obj == (object *) NULL) {
686 /* new object */
687 obj = o_new(file, ctrl);
688 if (strcmp(file, driver_object) == 0) {
689 obj->flags |= O_DRIVER;
690 } else if (strcmp(file, auto_object) == 0) {
691 obj->flags |= O_AUTO;
692 }
693 } else {
694 unsigned short *vmap;
695
696 /* recompiled object */
697 o_upgrade(obj, ctrl, f);
698 vmap = ctrl_varmap(obj->ctrl, ctrl);
699 if (vmap != (unsigned short *) NULL) {
700 d_set_varmap(ctrl, vmap);
701 }
702 }
703 return obj;
704 } else if (nerrors == 0) {
705 /* another try */
706 pp_clear();
707 ctrl_clear();
708 c_clear();
709 } else {
710 /* compilation failed */
711 error("Failed to compile \"/%s\"", file_c);
712 }
713 }
714 }
715
716 /*
717 * NAME: compile->autodriver()
718 * DESCRIPTION: indicate if the auto object or driver object is being
719 * compiled
720 */
c_autodriver()721 int c_autodriver()
722 {
723 if (strcmp(current->file, auto_object) == 0) {
724 return O_AUTO;
725 }
726 if (strcmp(current->file, driver_object) == 0) {
727 return O_DRIVER;
728 }
729 return 0;
730 }
731
732
733 /*
734 * NAME: revert_list()
735 * DESCRIPTION: revert a "linked list" of nodes
736 */
revert_list(node * n)737 static node *revert_list(node *n)
738 {
739 node *m;
740
741 if (n != (node *) NULL && n->type == N_PAIR) {
742 while ((m=n->l.left)->type == N_PAIR) {
743 /*
744 * ((a, b), c) -> (a, (b, c))
745 */
746 n->l.left = m->r.right;
747 m->r.right = n;
748 n = m;
749 }
750 }
751 return n;
752 }
753
754 /*
755 * NAME: compile->objecttype()
756 * DESCRIPTION: handle an object type
757 */
c_objecttype(node * n)758 string *c_objecttype(node *n)
759 {
760 char path[STRINGSZ];
761
762 if (!cg_compiled()) {
763 char *p;
764 frame *f;
765
766 f = current->frame;
767 p = tk_filename();
768 PUSH_STRVAL(f, str_new(p, strlen(p)));
769 PUSH_STRVAL(f, n->l.string);
770 call_driver_object(f, "object_type", 2);
771 if (f->sp->type != T_STRING) {
772 c_error("invalid object type");
773 p = n->l.string->text;
774 } else {
775 p = f->sp->u.string->text;
776 }
777 path_resolve(path, p);
778 i_del_value(f->sp++);
779 } else {
780 path_resolve(path, n->l.string->text);
781 }
782
783 return str_new(path, (long) strlen(path));
784 }
785
786 /*
787 * NAME: compile->decl_func()
788 * ACTION: declare a function
789 */
c_decl_func(unsigned short class,node * type,string * str,node * formals,bool function)790 static void c_decl_func(unsigned short class, node *type, string *str,
791 node *formals, bool function)
792 {
793 char proto[5 + (MAX_LOCALS + 1) * 4];
794 char tnbuf[TNBUFSIZE];
795 char *p, t;
796 int nargs, vargs;
797 long l;
798 bool typechecked, varargs;
799
800 varargs = FALSE;
801
802 /* check for some errors */
803 if ((class & (C_PRIVATE | C_NOMASK)) == (C_PRIVATE | C_NOMASK)) {
804 c_error("private contradicts nomask");
805 }
806 if (class & C_VARARGS) {
807 if (stricttc) {
808 c_error("varargs must be in parameter list");
809 }
810 class &= ~C_VARARGS;
811 varargs = TRUE;
812 }
813 t = type->mod;
814 if ((t & T_TYPE) == T_NIL) {
815 /* don't typecheck this function */
816 typechecked = FALSE;
817 t = T_MIXED;
818 } else {
819 typechecked = TRUE;
820 if (t != T_VOID && (t & T_TYPE) == T_VOID) {
821 c_error("invalid type for function %s (%s)", str->text,
822 i_typename(tnbuf, t));
823 t = T_MIXED;
824 }
825 }
826
827 /* handle function arguments */
828 ftype = t;
829 fclass = type->class;
830 p = &PROTO_FTYPE(proto);
831 nargs = vargs = 0;
832
833 if (formals != (node *) NULL && (formals->flags & F_ELLIPSIS)) {
834 class |= C_ELLIPSIS;
835 }
836 formals = revert_list(formals);
837 for (;;) {
838 *p++ = t;
839 if ((t & T_TYPE) == T_CLASS) {
840 l = ctrl_dstring(type->class);
841 *p++ = l >> 16;
842 *p++ = l >> 8;
843 *p++ = l;
844 }
845 if (formals == (node *) NULL) {
846 break;
847 }
848 if (nargs == MAX_LOCALS) {
849 c_error("too many parameters in function %s", str->text);
850 break;
851 }
852
853 if (formals->type == N_PAIR) {
854 type = formals->l.left;
855 formals = formals->r.right;
856 } else {
857 type = formals;
858 formals = (node *) NULL;
859 }
860 t = type->mod;
861 if ((t & T_TYPE) == T_NIL) {
862 if (typechecked) {
863 c_error("missing type for parameter %s", type->l.string->text);
864 }
865 t = T_MIXED;
866 } else if ((t & T_TYPE) == T_VOID) {
867 c_error("invalid type for parameter %s (%s)", type->l.string->text,
868 i_typename(tnbuf, t));
869 t = T_MIXED;
870 } else if (typechecked && t != T_MIXED) {
871 /* only bother to typecheck functions with non-mixed arguments */
872 class |= C_TYPECHECKED;
873 }
874 if (type->flags & F_VARARGS) {
875 if (varargs) {
876 c_error("extra varargs for parameter %s", type->l.string->text);
877 }
878 varargs = TRUE;
879 }
880 if (formals == (node *) NULL && (class & C_ELLIPSIS)) {
881 /* ... */
882 varargs = TRUE;
883 if (((t + (1 << REFSHIFT)) & T_REF) == 0) {
884 c_error("too deep indirection for parameter %s",
885 type->l.string->text);
886 }
887 if (function) {
888 block_pdef(type->l.string->text, t + (1 << REFSHIFT),
889 type->class);
890 }
891 } else if (function) {
892 block_pdef(type->l.string->text, t, type->class);
893 }
894
895 if (!varargs) {
896 nargs++;
897 } else {
898 vargs++;
899 }
900 }
901
902 PROTO_CLASS(proto) = class;
903 PROTO_NARGS(proto) = nargs;
904 PROTO_VARGS(proto) = vargs;
905 nargs = p - proto;
906 PROTO_HSIZE(proto) = nargs >> 8;
907 PROTO_LSIZE(proto) = nargs;
908
909 /* define prototype */
910 if (function) {
911 if (cg_compiled()) {
912 /* LPC compiled to C */
913 PROTO_CLASS(proto) |= C_COMPILED;
914 }
915 ctrl_dfunc(str, proto, fclass);
916 } else {
917 PROTO_CLASS(proto) |= C_UNDEFINED;
918 ctrl_dproto(str, proto, fclass);
919 }
920 }
921
922 /*
923 * NAME: compile->decl_var()
924 * DESCRIPTION: declare a variable
925 */
c_decl_var(unsigned short class,node * type,string * str,bool global)926 static void c_decl_var(unsigned short class, node *type, string *str,
927 bool global)
928 {
929 char tnbuf[TNBUFSIZE];
930
931 if ((type->mod & T_TYPE) == T_VOID) {
932 c_error("invalid type for variable %s (%s)", str->text,
933 i_typename(tnbuf, type->mod));
934 type->mod = T_MIXED;
935 }
936 if (global) {
937 if (class & (C_ATOMIC | C_NOMASK | C_VARARGS)) {
938 c_error("invalid class for variable %s", str->text);
939 }
940 ctrl_dvar(str, class, type->mod, type->class);
941 } else {
942 if (class != 0) {
943 c_error("invalid class for variable %s", str->text);
944 }
945 block_vdef(str->text, type->mod, type->class);
946 }
947 }
948
949 /*
950 * NAME: compile->decl_list()
951 * DESCRIPTION: handle a list of declarations
952 */
c_decl_list(unsigned short class,node * type,node * list,bool global)953 static void c_decl_list(unsigned short class, node *type, node *list,
954 bool global)
955 {
956 node *n;
957
958 list = revert_list(list); /* for proper order of err mesgs */
959 while (list != (node *) NULL) {
960 if (list->type == N_PAIR) {
961 n = list->l.left;
962 list = list->r.right;
963 } else {
964 n = list;
965 list = (node *) NULL;
966 }
967 type->mod = (type->mod & T_TYPE) | n->mod;
968 if (n->type == N_FUNC) {
969 c_decl_func(class, type, n->l.left->l.string, n->r.right, FALSE);
970 } else {
971 c_decl_var(class, type, n->l.string, global);
972 }
973 }
974 }
975
976 /*
977 * NAME: compile->global()
978 * DESCRIPTION: handle a global declaration
979 */
c_global(unsigned int class,node * type,node * n)980 void c_global(unsigned int class, node *type, node *n)
981 {
982 if (!seen_decls) {
983 ctrl_create();
984 seen_decls = TRUE;
985 }
986 c_decl_list(class, type, n, TRUE);
987 }
988
989 static string *fname; /* name of current function */
990 static unsigned short fline; /* first line of function */
991
992 /*
993 * NAME: compile->function()
994 * DESCRIPTION: create a function
995 */
c_function(unsigned int class,node * type,node * n)996 void c_function(unsigned int class, node *type, node *n)
997 {
998 if (!seen_decls) {
999 ctrl_create();
1000 seen_decls = TRUE;
1001 }
1002 type->mod |= n->mod;
1003 c_decl_func(class, type, fname = n->l.left->l.string, n->r.right, TRUE);
1004 }
1005
1006 /*
1007 * NAME: compile->funcbody()
1008 * DESCRIPTION: create a function body
1009 */
c_funcbody(node * n)1010 void c_funcbody(node *n)
1011 {
1012 char *prog;
1013 Uint depth;
1014 unsigned short size;
1015 xfloat flt;
1016
1017 FLT_ZERO(flt.high, flt.low);
1018 switch (ftype) {
1019 case T_INT:
1020 n = c_concat(n, node_mon(N_RETURN, 0, node_int((Int) 0)));
1021 break;
1022
1023 case T_FLOAT:
1024 n = c_concat(n, node_mon(N_RETURN, 0, node_float(&flt)));
1025 break;
1026
1027 default:
1028 n = c_concat(n, node_mon(N_RETURN, 0, node_nil()));
1029 break;
1030 }
1031
1032 n = opt_stmt(n, &depth);
1033 if (depth > 0x7fff) {
1034 c_error("function uses too much stack space");
1035 } else {
1036 prog = cg_function(fname, n, nvars, nparams, (unsigned short) depth,
1037 &size);
1038 ctrl_dprogram(prog, size);
1039 }
1040 node_free();
1041 vindex = 0;
1042 nvars = 0;
1043 nparams = 0;
1044 }
1045
1046 /*
1047 * NAME: compile->local()
1048 * DESCRIPTION: handle local declarations
1049 */
c_local(unsigned int class,node * type,node * n)1050 void c_local(unsigned int class, node *type, node *n)
1051 {
1052 c_decl_list(class, type, n, FALSE);
1053 }
1054
1055
1056 /*
1057 * NAME: compile->startcond()
1058 * DESCRIPTION: start a condition
1059 */
c_startcond()1060 void c_startcond()
1061 {
1062 cond_new(thiscond);
1063 }
1064
1065 /*
1066 * NAME: compile->startcond2()
1067 * DESCRIPTION: start a second condition
1068 */
c_startcond2()1069 void c_startcond2()
1070 {
1071 cond_new(thiscond->prev);
1072 }
1073
1074 /*
1075 * NAME: compile->endcond()
1076 * DESCRIPTION: end a condition
1077 */
c_endcond()1078 void c_endcond()
1079 {
1080 cond_del();
1081 }
1082
1083 /*
1084 * NAME: compile->matchcond()
1085 * DESCRIPTION: match and end two conditions
1086 */
c_matchcond()1087 void c_matchcond()
1088 {
1089 cond_match(thiscond->prev->prev, thiscond->prev, thiscond);
1090 cond_del();
1091 cond_del();
1092 }
1093
1094 /*
1095 * NAME: compile->nil()
1096 * DESCRIPTION: check if an expression has the value nil
1097 */
c_nil(node * n)1098 bool c_nil(node *n)
1099 {
1100 if (n->type == N_COMMA) {
1101 /* the parser always generates comma expressions as (a, b), c */
1102 n = n->r.right;
1103 }
1104 return (n->type == nil_node && n->l.number == 0);
1105 }
1106
1107 /*
1108 * NAME: compile->concat()
1109 * DESCRIPTION: concatenate two statements
1110 */
c_concat(node * n1,node * n2)1111 node *c_concat(node *n1, node *n2)
1112 {
1113 node *n;
1114
1115 if (n1 == (node *) NULL) {
1116 return n2;
1117 } else if (n2 == (node *) NULL ||
1118 ((n1->flags & F_END) && !(n2->flags & F_REACH))) {
1119 return n1;
1120 }
1121
1122 n = node_bin(N_PAIR, 0, n1, n2);
1123 n->flags |= (n1->flags & (F_ENTRY | F_REACH)) |
1124 (n2->flags & (F_REACH | F_END));
1125 return n;
1126 }
1127
1128 /*
1129 * NAME: compile->exp_stmt()
1130 * DESCRIPTION: reduce an expression to a statement
1131 */
c_exp_stmt(node * n)1132 node *c_exp_stmt(node *n)
1133 {
1134 if (n != (node *) NULL) {
1135 return node_mon(N_POP, 0, n);
1136 }
1137 return n;
1138 }
1139
1140 /*
1141 * NAME: compile->if()
1142 * DESCRIPTION: handle an if statement
1143 */
c_if(node * n1,node * n2)1144 node *c_if(node *n1, node *n2)
1145 {
1146 return node_bin(N_IF, 0, n1, node_mon(N_ELSE, 0, n2));
1147 }
1148
1149 /*
1150 * NAME: compile->endif()
1151 * DESCRIPTION: end an if statement
1152 */
c_endif(node * n1,node * n3)1153 node *c_endif(node *n1, node *n3)
1154 {
1155 node *n2;
1156 int flags1, flags2;
1157
1158 n2 = n1->r.right->l.left;
1159 n1->r.right->r.right = n3;
1160 if (n2 != (node *) NULL) {
1161 flags1 = n2->flags & F_END;
1162 n1->flags |= n2->flags & F_REACH;
1163 } else {
1164 flags1 = 0;
1165 }
1166 if (n3 != (node *) NULL) {
1167 flags2 = n3->flags & F_END;
1168 n1->flags |= n3->flags & F_REACH;
1169 } else {
1170 flags2 = 0;
1171 }
1172
1173 if (flags1 != 0 && flags2 != 0) {
1174 n1->flags |= flags1 | flags2;
1175 }
1176 return n1;
1177 }
1178
1179 /*
1180 * NAME: compile->block()
1181 * DESCRIPTION: create a scope block for break or continue
1182 */
c_block(node * n,int type,int flags)1183 static node *c_block(node *n, int type, int flags)
1184 {
1185 n = node_mon(N_BLOCK, type, n);
1186 n->flags |= n->l.left->flags & F_FLOW & ~F_RETURN & ~flags;
1187 return n;
1188 }
1189
1190 /*
1191 * NAME: compile->loop()
1192 * DESCRIPTION: start a loop
1193 */
c_loop()1194 void c_loop()
1195 {
1196 thisloop = loop_new(thisloop);
1197 }
1198
1199 /*
1200 * NAME: compile->reloop()
1201 * DESCRIPTION: loop back a loop
1202 */
c_reloop(node * n)1203 static node *c_reloop(node *n)
1204 {
1205 return (thisloop->cont) ? c_block(n, N_CONTINUE, F_END) : n;
1206 }
1207
1208 /*
1209 * NAME: compile->endloop()
1210 * DESCRIPTION: end a loop
1211 */
c_endloop(node * n)1212 static node *c_endloop(node *n)
1213 {
1214 if (thisloop->brk) {
1215 n = c_block(n, N_BREAK, F_BREAK);
1216 }
1217 thisloop = loop_del(thisloop);
1218 return n;
1219 }
1220
1221 /*
1222 * NAME: compile->do()
1223 * DESCRIPTION: end a do-while loop
1224 */
c_do(node * n1,node * n2)1225 node *c_do(node *n1, node *n2)
1226 {
1227 n1 = node_bin(N_DO, 0, n1, n2 = c_reloop(n2));
1228 if (n2 != (node *) NULL) {
1229 n1->flags |= n2->flags & F_FLOW;
1230 }
1231 return c_endloop(n1);
1232 }
1233
1234 /*
1235 * NAME: compile->while()
1236 * DESCRIPTION: end a while loop
1237 */
c_while(node * n1,node * n2)1238 node *c_while(node *n1, node *n2)
1239 {
1240 n1 = node_bin(N_FOR, 0, n1, n2 = c_reloop(n2));
1241 if (n2 != (node *) NULL) {
1242 n1->flags |= n2->flags & F_FLOW & ~(F_ENTRY | F_RETURN);
1243 }
1244 return c_endloop(n1);
1245 }
1246
1247 /*
1248 * NAME: compile->for()
1249 * DESCRIPTION: end a for loop
1250 */
c_for(node * n1,node * n2,node * n3,node * n4)1251 node *c_for(node *n1, node *n2, node *n3, node *n4)
1252 {
1253 n4 = c_reloop(n4);
1254 n2 = node_bin((n2 == (node *) NULL) ? N_FOREVER : N_FOR,
1255 0, n2, c_concat(n4, n3));
1256 if (n4 != (node *) NULL) {
1257 n2->flags = n4->flags & F_FLOW & ~(F_ENTRY | F_RETURN);
1258 }
1259
1260 return c_concat(n1, c_endloop(n2));
1261 }
1262
1263 /*
1264 * NAME: compile->startrlimits()
1265 * DESCRIPTION: begin rlimit handling
1266 */
c_startrlimits()1267 void c_startrlimits()
1268 {
1269 nesting++;
1270 }
1271
1272 /*
1273 * NAME: compile->endrlimits()
1274 * DESCRIPTION: handle statements with resource limitations
1275 */
c_endrlimits(node * n1,node * n2,node * n3)1276 node *c_endrlimits(node *n1, node *n2, node *n3)
1277 {
1278 --nesting;
1279
1280 if (strcmp(current->file, driver_object) == 0 ||
1281 strcmp(current->file, auto_object) == 0) {
1282 n1 = node_bin(N_RLIMITS, 1, node_bin(N_PAIR, 0, n1, n2), n3);
1283 } else {
1284 frame *f;
1285
1286 f = current->frame;
1287 PUSH_STRVAL(f, str_new((char *) NULL, strlen(current->file) + 1L));
1288 f->sp->u.string->text[0] = '/';
1289 strcpy(f->sp->u.string->text + 1, current->file);
1290 call_driver_object(f, "compile_rlimits", 1);
1291 n1 = node_bin(N_RLIMITS, VAL_TRUE(f->sp), node_bin(N_PAIR, 0, n1, n2),
1292 n3);
1293 i_del_value(f->sp++);
1294 }
1295
1296 if (n3 != (node *) NULL) {
1297 n1->flags |= n3->flags & F_END;
1298 }
1299 return n1;
1300 }
1301
1302 /*
1303 * NAME: compile->startcatch()
1304 * DESCRIPTION: begin catch handling
1305 */
c_startcatch()1306 void c_startcatch()
1307 {
1308 nesting++;
1309 }
1310
1311 /*
1312 * NAME: compile->endcatch()
1313 * DESCRIPTION: end catch handling
1314 */
c_endcatch()1315 void c_endcatch()
1316 {
1317 --nesting;
1318 }
1319
1320 /*
1321 * NAME: compile->donecatch()
1322 * DESCRIPTION: handle statements within catch
1323 */
c_donecatch(node * n1,node * n2)1324 node *c_donecatch(node *n1, node *n2)
1325 {
1326 node *n;
1327 int flags1, flags2;
1328
1329 n = node_bin(N_CATCH, 0, n1, n2);
1330 if (n1 != (node *) NULL) {
1331 flags1 = n1->flags & F_END;
1332 } else {
1333 flags1 = 0;
1334 }
1335 if (n2 != (node *) NULL) {
1336 n->flags |= n2->flags & F_REACH;
1337 flags2 = n2->flags & F_END;
1338 } else {
1339 flags2 = 0;
1340 }
1341
1342 if (flags1 != 0 && flags2 != 0) {
1343 n->flags |= flags1 | flags2;
1344 }
1345 return n;
1346 }
1347
1348 /*
1349 * NAME: compile->startswitch()
1350 * DESCRIPTION: start a switch statement
1351 */
c_startswitch(node * n,int typechecked)1352 void c_startswitch(node *n, int typechecked)
1353 {
1354 char tnbuf[TNBUFSIZE];
1355
1356 switch_list = loop_new(switch_list);
1357 switch_list->type = T_MIXED;
1358 if (typechecked &&
1359 n->mod != T_INT && n->mod != T_STRING && n->mod != T_MIXED) {
1360 c_error("bad switch expression type (%s)", i_typename(tnbuf, n->mod));
1361 switch_list->type = T_NIL;
1362 }
1363 switch_list->dflt = FALSE;
1364 switch_list->ncase = 0;
1365 switch_list->case_list = case_list;
1366 switch_list->vlist = (node *) NULL;
1367 case_list = (node *) NULL;
1368 switch_list->env = thisloop;
1369 }
1370
1371 static int cmp (cvoid*, cvoid*);
1372
1373 /*
1374 * NAME: cmp()
1375 * DESCRIPTION: compare two case label nodes
1376 */
cmp(cvoid * cv1,cvoid * cv2)1377 static int cmp(cvoid *cv1, cvoid *cv2)
1378 {
1379 node **n1, **n2;
1380
1381 n1 = (node **) cv1;
1382 n2 = (node **) cv2;
1383 if (n1[0]->l.left->type == N_STR) {
1384 if (n2[0]->l.left->type == N_STR) {
1385 return str_cmp(n1[0]->l.left->l.string, n2[0]->l.left->l.string);
1386 } else {
1387 return 1; /* str > nil */
1388 }
1389 } else if (n2[0]->l.left->type == N_STR) {
1390 return -1; /* nil < str */
1391 } else {
1392 return (n1[0]->l.left->l.number <= n2[0]->l.left->l.number) ? -1 : 1;
1393 }
1394 }
1395
1396 /*
1397 * NAME: compile->endswitch()
1398 * DESCRIPTION: end a switch
1399 */
c_endswitch(node * expr,node * stmt)1400 node *c_endswitch(node *expr, node *stmt)
1401 {
1402 char tnbuf[TNBUFSIZE];
1403 node **v, **w, *n;
1404 unsigned short i, size;
1405 long l;
1406 unsigned long cnt;
1407 short type, sz;
1408
1409 n = stmt;
1410 if (n != (node *) NULL) {
1411 n->r.right = switch_list->vlist;
1412 if (switch_list->prev != (loop *) NULL) {
1413 switch_list->prev->vlist = c_concat(n->r.right,
1414 switch_list->prev->vlist);
1415 }
1416 }
1417
1418 if (switch_list->type != T_NIL) {
1419 if (stmt == (node *) NULL) {
1420 /* empty switch statement */
1421 n = c_exp_stmt(expr);
1422 } else if (!(stmt->flags & F_ENTRY)) {
1423 c_error("unreachable code in switch");
1424 } else if (switch_list->ncase > 0x7fff) {
1425 c_error("too many cases in switch");
1426 } else if ((size=switch_list->ncase - switch_list->dflt) == 0) {
1427 if (switch_list->ncase == 0) {
1428 /* can happen when recovering from syntax error */
1429 n = c_exp_stmt(expr);
1430 } else {
1431 /* only a default label: erase N_CASE */
1432 n = case_list->r.right->r.right->l.left;
1433 *(case_list->r.right->r.right) = *n;
1434 n->type = N_FAKE;
1435 if (switch_list->brk) {
1436 /*
1437 * enclose the break statement with a proper block
1438 */
1439 stmt = c_concat(stmt, node_mon(N_BREAK, 0, (node *) NULL));
1440 stmt = node_bin(N_FOREVER, 0, (node *) NULL, stmt);
1441 stmt->flags |= stmt->r.right->flags & F_FLOW;
1442 stmt = c_block(stmt, N_BREAK, F_BREAK);
1443 }
1444 n = c_concat(c_exp_stmt(expr), stmt);
1445 }
1446 } else if (expr->mod != T_MIXED && expr->mod != switch_list->type &&
1447 switch_list->type != T_MIXED) {
1448 c_error("wrong switch expression type (%s)",
1449 i_typename(tnbuf, expr->mod));
1450 } else {
1451 /*
1452 * get the labels in an array, and sort them
1453 */
1454 v = ALLOCA(node*, size);
1455 for (i = size, n = case_list; i > 0; n = n->l.left) {
1456 if (n->r.right->l.left != (node *) NULL) {
1457 *v++ = n->r.right;
1458 --i;
1459 }
1460 }
1461 qsort(v -= size, size, sizeof(node *), cmp);
1462
1463 if (switch_list->type == T_STRING) {
1464 type = N_SWITCH_STR;
1465 if (size >= 2) {
1466 /*
1467 * check for duplicate cases
1468 */
1469 if (v[1]->l.left->type == nil_node) {
1470 c_error("duplicate case labels in switch");
1471 } else {
1472 i = (v[0]->l.left->type == nil_node);
1473 for (w = v + i, i = size - i - 1; i > 0; w++, --i) {
1474 if (str_cmp(w[0]->l.left->l.string,
1475 w[1]->l.left->l.string) == 0) {
1476 c_error("duplicate case labels in switch");
1477 break;
1478 }
1479 }
1480 }
1481 }
1482 sz = 0;
1483 } else {
1484 type = N_SWITCH_INT;
1485 /*
1486 * check for duplicate cases
1487 */
1488 i = size;
1489 cnt = 0;
1490 w = v;
1491 for (;;) {
1492 cnt += w[0]->l.left->r.number - w[0]->l.left->l.number + 1;
1493 if (--i == 0) {
1494 break;
1495 }
1496 if (w[0]->l.left->r.number >= w[1]->l.left->l.number) {
1497 if (w[0]->l.left->l.number == w[1]->l.left->r.number) {
1498 c_error("duplicate case labels in switch");
1499 } else {
1500 c_error("overlapping case label ranges in switch");
1501 }
1502 break;
1503 }
1504 w++;
1505 }
1506
1507 /* determine the number of bytes per case */
1508 l = v[0]->l.left->l.number;
1509 if (l < 0) {
1510 l = -1 - l;
1511 }
1512 if (l < w[0]->l.left->r.number) {
1513 l = w[0]->l.left->r.number;
1514 }
1515 if (l <= 127) {
1516 sz = 1;
1517 } else if (l <= 32767) {
1518 sz = 2;
1519 } else if (l <= 8388607L) {
1520 sz = 3;
1521 } else {
1522 sz = 4;
1523 }
1524
1525 if (i == 0 && cnt > size) {
1526 if (cnt > 0xffffffffL / 6 ||
1527 (sz + 2L) * cnt > (2 * sz + 2L) * size) {
1528 /*
1529 * no point in changing the type of switch
1530 */
1531 type = N_SWITCH_RANGE;
1532 } else {
1533 /*
1534 * convert range label switch to int label switch
1535 * by adding new labels
1536 */
1537 w = ALLOCA(node*, cnt);
1538 for (i = size; i > 0; --i) {
1539 *w++ = *v;
1540 for (l = v[0]->l.left->l.number;
1541 l < v[0]->l.left->r.number; ) {
1542 /* insert N_CASE in statement */
1543 n = node_mon(N_CASE, 0, v[0]->r.right->l.left);
1544 v[0]->r.right->l.left = n;
1545 l++;
1546 *w++ = node_bin(N_PAIR, 0, node_int((Int)l), n);
1547 }
1548 v++;
1549 }
1550 AFREE(v - size);
1551 size = cnt;
1552 v = w - size;
1553 }
1554 }
1555 }
1556
1557 /*
1558 * turn array into linked list
1559 */
1560 v += size;
1561 n = (node *) NULL;
1562 i = size;
1563 do {
1564 (*--v)->r.right->mod = i;
1565 n = node_bin(N_PAIR, 0, v[0]->l.left, n);
1566 } while (--i > 0);
1567 AFREE(v);
1568 if (switch_list->dflt) {
1569 /* add default case */
1570 n = node_bin(N_PAIR, 0, (node *) NULL, n);
1571 size++;
1572 }
1573
1574 if (switch_list->brk) {
1575 stmt = c_block(stmt, N_BREAK, F_BREAK);
1576 }
1577 n = node_bin(type, size, n, node_bin(N_PAIR, sz, expr, stmt));
1578 }
1579 }
1580
1581 case_list = switch_list->case_list;
1582 switch_list = loop_del(switch_list);
1583 if (switch_list == (loop *) NULL) {
1584 vindex = thisblock->vindex + thisblock->nvars;
1585 }
1586
1587 return n;
1588 }
1589
1590 /*
1591 * NAME: compile->case()
1592 * DESCRIPTION: handle a case label
1593 */
c_case(node * n1,node * n2)1594 node *c_case(node *n1, node *n2)
1595 {
1596 if (switch_list == (loop *) NULL) {
1597 c_error("case label not inside switch");
1598 return (node *) NULL;
1599 }
1600 if (switch_list->nesting != nesting) {
1601 c_error("illegal jump into rlimits or catch");
1602 return (node *) NULL;
1603 }
1604 if (switch_list->type == T_NIL) {
1605 return (node *) NULL;
1606 }
1607
1608 if (n1->type == N_STR || n1->type == N_NIL) {
1609 /* string */
1610 if (n2 != (node *) NULL) {
1611 c_error("bad case range");
1612 switch_list->type = T_NIL;
1613 return (node *) NULL;
1614 }
1615 /* compare type with other cases */
1616 if (switch_list->type == T_MIXED) {
1617 switch_list->type = T_STRING;
1618 } else if (switch_list->type != T_STRING) {
1619 c_error("multiple case types in switch");
1620 switch_list->type = T_NIL;
1621 return (node *) NULL;
1622 }
1623 } else {
1624 /* int */
1625 if (n1->type != N_INT) {
1626 c_error("bad case expression");
1627 switch_list->type = T_NIL;
1628 return (node *) NULL;
1629 }
1630 if (n2 == (node *) NULL) {
1631 n1->r.number = n1->l.number;
1632 } else {
1633 /* range */
1634 if (n2->type != N_INT) {
1635 c_error("bad case range");
1636 switch_list->type = T_NIL;
1637 return (node *) NULL;
1638 }
1639 if (n2->l.number < n1->l.number) {
1640 /* inverted range */
1641 n1->r.number = n1->l.number;
1642 n1->l.number = n2->l.number;
1643 n1->type = N_RANGE;
1644 } else {
1645 n1->r.number = n2->l.number;
1646 if (n1->l.number != n1->r.number) {
1647 n1->type = N_RANGE;
1648 }
1649 }
1650 }
1651 /* compare type with other cases */
1652 if (n1->l.number != 0 || n2 != (node *) NULL || nil_type != T_INT) {
1653 if (switch_list->type == T_MIXED) {
1654 switch_list->type = T_INT;
1655 } else if (switch_list->type != T_INT) {
1656 c_error("multiple case types in switch");
1657 switch_list->type = T_NIL;
1658 return (node *) NULL;
1659 }
1660 }
1661 }
1662
1663 switch_list->ncase++;
1664 n2 = node_mon(N_CASE, 0, (node *) NULL);
1665 n2->flags |= F_ENTRY | F_REACH;
1666 case_list = node_bin(N_PAIR, 0, case_list, node_bin(N_PAIR, 0, n1, n2));
1667 return n2;
1668 }
1669
1670 /*
1671 * NAME: compile->default()
1672 * DESCRIPTION: handle a default label
1673 */
c_default()1674 node *c_default()
1675 {
1676 node *n;
1677
1678 n = (node *) NULL;
1679 if (switch_list == (loop *) NULL) {
1680 c_error("default label not inside switch");
1681 } else if (switch_list->dflt) {
1682 c_error("duplicate default label in switch");
1683 switch_list->type = T_NIL;
1684 } else if (switch_list->nesting != nesting) {
1685 c_error("illegal jump into rlimits or catch");
1686 } else {
1687 switch_list->ncase++;
1688 switch_list->dflt = TRUE;
1689 n = node_mon(N_CASE, 0, (node *) NULL);
1690 n->flags |= F_ENTRY | F_REACH;
1691 case_list = node_bin(N_PAIR, 0, case_list,
1692 node_bin(N_PAIR, 0, (node *) NULL, n));
1693 }
1694
1695 return n;
1696 }
1697
1698 /*
1699 * NAME: compile->break()
1700 * DESCRIPTION: handle a break statement
1701 */
c_break()1702 node *c_break()
1703 {
1704 loop *l;
1705 node *n;
1706
1707 l = switch_list;
1708 if (l == (loop *) NULL || switch_list->env != thisloop) {
1709 /* no switch, or loop inside switch */
1710 l = thisloop;
1711 }
1712 if (l == (loop *) NULL) {
1713 c_error("break statement not inside loop or switch");
1714 return (node *) NULL;
1715 }
1716 l->brk = TRUE;
1717
1718 n = node_mon(N_BREAK, nesting - l->nesting, (node *) NULL);
1719 n->flags |= F_BREAK;
1720 return n;
1721 }
1722
1723 /*
1724 * NAME: compile->continue()
1725 * DESCRIPTION: handle a continue statement
1726 */
c_continue()1727 node *c_continue()
1728 {
1729 node *n;
1730
1731 if (thisloop == (loop *) NULL) {
1732 c_error("continue statement not inside loop");
1733 return (node *) NULL;
1734 }
1735 thisloop->cont = TRUE;
1736
1737 n = node_mon(N_CONTINUE, nesting - thisloop->nesting, (node *) NULL);
1738 n->flags |= F_CONTINUE;
1739 return n;
1740 }
1741
1742 /*
1743 * NAME: compile->return()
1744 * DESCRIPTION: handle a return statement
1745 */
c_return(node * n,int typechecked)1746 node *c_return(node *n, int typechecked)
1747 {
1748 char tnbuf1[TNBUFSIZE], tnbuf2[TNBUFSIZE];
1749
1750 if (n == (node *) NULL) {
1751 if (typechecked && ftype != T_VOID) {
1752 c_error("function must return value");
1753 }
1754 n = node_nil();
1755 } else if (typechecked) {
1756 if (ftype == T_VOID) {
1757 /*
1758 * can't return anything from a void function
1759 */
1760 c_error("value returned from void function");
1761 } else if ((!c_nil(n) || !T_POINTER(ftype)) &&
1762 c_tmatch(n->mod, ftype) == T_NIL) {
1763 /*
1764 * type error
1765 */
1766 c_error("returned value doesn't match %s (%s)",
1767 i_typename(tnbuf1, ftype), i_typename(tnbuf2, n->mod));
1768 } else if ((ftype != T_MIXED && n->mod == T_MIXED) ||
1769 (ftype == T_CLASS &&
1770 (n->mod != T_CLASS || str_cmp(fclass, n->class) != 0))) {
1771 /*
1772 * typecheck at runtime
1773 */
1774 n = node_mon(N_CAST, ftype, n);
1775 n->class = fclass;
1776 }
1777 }
1778
1779 n = node_mon(N_RETURN, nesting, n);
1780 n->flags |= F_RETURN;
1781 return n;
1782 }
1783
1784 /*
1785 * NAME: compile->startcompound()
1786 * DESCRIPTION: start a compound statement
1787 */
c_startcompound()1788 void c_startcompound()
1789 {
1790 if (thisblock == (block *) NULL) {
1791 fline = tk_line();
1792 }
1793 block_new();
1794 }
1795
1796 /*
1797 * NAME: compile->endcompound()
1798 * DESCRIPTION: end a compound statement
1799 */
c_endcompound(node * n)1800 node *c_endcompound(node *n)
1801 {
1802 int flags;
1803
1804 if (n != (node *) NULL) {
1805 if (n->type == N_PAIR) {
1806 flags = n->flags & (F_REACH | F_END);
1807 n = revert_list(n);
1808 n->flags = (n->flags & ~F_END) | flags;
1809 }
1810 n = node_mon(N_COMPOUND, 0, n);
1811 n->flags = n->l.left->flags;
1812
1813 if (thisblock->nvars != 0) {
1814 node *v, *l, *z, *f, *p;
1815 int i;
1816
1817 /*
1818 * create variable type definitions and implicit initializers
1819 */
1820 l = z = f = p = (node *) NULL;
1821 i = thisblock->vindex;
1822 if (i < nparams) {
1823 i = nparams;
1824 }
1825 while (i < thisblock->vindex + thisblock->nvars) {
1826 l = c_concat(node_var(variables[i].type, i), l);
1827
1828 if (switch_list != (loop *) NULL || variables[i].unset) {
1829 switch (variables[i].type) {
1830 case T_INT:
1831 v = node_mon(N_LOCAL, T_INT, (node *) NULL);
1832 v->line = 0;
1833 v->r.number = i;
1834 if (z == (node *) NULL) {
1835 z = node_int(0);
1836 z->line = 0;
1837 }
1838 z = node_bin(N_ASSIGN, T_INT, v, z);
1839 z->line = 0;
1840 break;
1841
1842 case T_FLOAT:
1843 v = node_mon(N_LOCAL, T_FLOAT, (node *) NULL);
1844 v->line = 0;
1845 v->r.number = i;
1846 if (f == (node *) NULL) {
1847 xfloat flt;
1848
1849 FLT_ZERO(flt.high, flt.low);
1850 f = node_float(&flt);
1851 f->line = 0;
1852 }
1853 f = node_bin(N_ASSIGN, T_FLOAT, v, f);
1854 f->line = 0;
1855 break;
1856
1857 default:
1858 v = node_mon(N_LOCAL, T_MIXED, (node *) NULL);
1859 v->line = 0;
1860 v->r.number = i;
1861 if (p == (node *) NULL) {
1862 p = node_nil();
1863 p->line = 0;
1864 }
1865 p = node_bin(N_ASSIGN, T_MIXED, v, p);
1866 p->line = 0;
1867 break;
1868 }
1869 }
1870 i++;
1871 }
1872
1873 /* add vartypes and initializers to compound statement */
1874 if (z != (node *) NULL) {
1875 l = c_concat(c_exp_stmt(z), l);
1876 }
1877 if (f != (node *) NULL) {
1878 l = c_concat(c_exp_stmt(f), l);
1879 }
1880 if (p != (node *) NULL) {
1881 l = c_concat(c_exp_stmt(p), l);
1882 }
1883 n->r.right = l;
1884 if (switch_list != (loop *) NULL) {
1885 switch_list->vlist = c_concat(l, switch_list->vlist);
1886 }
1887 }
1888 }
1889
1890 block_del(switch_list != (loop *) NULL);
1891 return n;
1892 }
1893
1894 /*
1895 * NAME: compile->flookup()
1896 * DESCRIPTION: look up a local function, inherited function or kfun
1897 */
c_flookup(node * n,int typechecked)1898 node *c_flookup(node *n, int typechecked)
1899 {
1900 char *proto;
1901 string *class;
1902 long call;
1903
1904 proto = ctrl_fcall(n->l.string, &class, &call, typechecked);
1905 n->r.right = (proto == (char *) NULL) ? (node *) NULL :
1906 node_fcall(PROTO_FTYPE(proto), class, proto, (Int) call);
1907 return n;
1908 }
1909
1910 /*
1911 * NAME: compile->iflookup()
1912 * DESCRIPTION: look up an inherited function
1913 */
c_iflookup(node * n,node * label)1914 node *c_iflookup(node *n, node *label)
1915 {
1916 char *proto;
1917 string *class;
1918 long call;
1919
1920 proto = ctrl_ifcall(n->l.string, (label != (node *) NULL) ?
1921 label->l.string->text : (char *) NULL,
1922 &class, &call);
1923 n->r.right = (proto == (char *) NULL) ? (node *) NULL :
1924 node_fcall(PROTO_FTYPE(proto), class, proto, (Int) call);
1925 return n;
1926 }
1927
1928 /*
1929 * NAME: compile->aggregate()
1930 * DESCRIPTION: create an aggregate
1931 */
c_aggregate(node * n,unsigned int type)1932 node *c_aggregate(node *n, unsigned int type)
1933 {
1934 return node_mon(N_AGGR, type, revert_list(n));
1935 }
1936
1937 /*
1938 * NAME: compile->variable()
1939 * DESCRIPTION: create a reference to a variable
1940 */
c_variable(node * n)1941 node *c_variable(node *n)
1942 {
1943 int i;
1944
1945 i = block_var(n->l.string->text);
1946 if (i >= 0) {
1947 /* local var */
1948 if (!BTST(thiscond->init, i)) {
1949 variables[i].unset++;
1950 }
1951 n = node_mon(N_LOCAL, variables[i].type, n);
1952 n->class = variables[i].cvstr;
1953 n->r.number = i;
1954 } else {
1955 string *class;
1956 long ref;
1957
1958 /*
1959 * try a global variable
1960 */
1961 n = node_mon(N_GLOBAL, ctrl_var(n->l.string, &ref, &class), n);
1962 n->class = class;
1963 n->r.number = ref;
1964 }
1965 return n;
1966 }
1967
1968 /*
1969 * NAME: compile->vtype()
1970 * DESCRIPTION: return the type of a variable
1971 */
c_vtype(int i)1972 short c_vtype(int i)
1973 {
1974 return variables[i].type;
1975 }
1976
1977 /*
1978 * NAME: lvalue()
1979 * DESCRIPTION: check if a value can be an lvalue
1980 */
lvalue(node * n)1981 static bool lvalue(node *n)
1982 {
1983 if (n->type == N_CAST && n->mod == n->l.left->mod) {
1984 /* only an implicit cast is allowed */
1985 n = n->l.left;
1986 }
1987 switch (n->type) {
1988 case N_LOCAL:
1989 case N_GLOBAL:
1990 case N_INDEX:
1991 case N_FAKE:
1992 return TRUE;
1993
1994 default:
1995 return FALSE;
1996 }
1997 }
1998
1999 /*
2000 * NAME: funcall()
2001 * DESCRIPTION: handle a function call
2002 */
funcall(node * call,node * args,int funcptr)2003 static node *funcall(node *call, node *args, int funcptr)
2004 {
2005 char tnbuf[TNBUFSIZE];
2006 int n, nargs, t;
2007 node *func, **argv, **arg;
2008 char *argp, *proto, *fname;
2009 bool typechecked, ellipsis;
2010 int spread;
2011
2012 /* get info, prepare return value */
2013 fname = call->l.string->text;
2014 func = call->r.right;
2015 if (func == (node *) NULL) {
2016 /* error during function lookup */
2017 return node_mon(N_FAKE, T_MIXED, (node *) NULL);
2018 }
2019 proto = func->l.ptr;
2020 if (func->mod == T_IMPLICIT) {
2021 func->mod = T_MIXED;
2022 }
2023 func->l.left = call;
2024 call->r.right = args;
2025 argv = &call->r.right;
2026
2027 # ifdef CLOSURES
2028 if (funcptr) {
2029 if (func->r.number >> 24 == KFCALL) {
2030 c_error("cannot create pointer to kfun");
2031 }
2032 if (PROTO_CLASS(proto) & C_PRIVATE) {
2033 c_error("cannot create pointer to private function");
2034 }
2035 }
2036 # endif
2037
2038 /*
2039 * check function arguments
2040 */
2041 typechecked = ((PROTO_CLASS(proto) & C_TYPECHECKED) != 0);
2042 ellipsis = (PROTO_CLASS(proto) & C_ELLIPSIS);
2043 nargs = PROTO_NARGS(proto) + PROTO_VARGS(proto);
2044 argp = PROTO_ARGS(proto);
2045 for (n = 1; n <= nargs; n++) {
2046 if (args == (node *) NULL) {
2047 if (n <= PROTO_NARGS(proto) && !funcptr) {
2048 c_error("too few arguments for function %s", fname);
2049 }
2050 break;
2051 }
2052 if ((*argv)->type == N_PAIR) {
2053 arg = &(*argv)->l.left;
2054 argv = &(*argv)->r.right;
2055 } else {
2056 arg = argv;
2057 args = (node *) NULL;
2058 }
2059 t = UCHAR(*argp);
2060
2061 if ((*arg)->type == N_SPREAD) {
2062 t = (*arg)->l.left->mod;
2063 if (t != T_MIXED) {
2064 if ((t & T_REF) == 0) {
2065 c_error("ellipsis requires array");
2066 t = T_MIXED;
2067 } else {
2068 t -= (1 << REFSHIFT);
2069 }
2070 }
2071
2072 spread = n;
2073 while (n <= nargs) {
2074 if (*argp == T_LVALUE) {
2075 (*arg)->mod = n - spread;
2076 /* KFCALL => KFCALL_LVAL */
2077 func->r.number |= (long) KFCALL_LVAL << 24;
2078 break;
2079 }
2080 if (typechecked && c_tmatch(t, *argp) == T_NIL) {
2081 c_error("bad argument %d for function %s (needs %s)", n,
2082 fname, i_typename(tnbuf, *argp));
2083 }
2084 n++;
2085 argp += ((*argp & T_TYPE) == T_CLASS) ? 4 : 1;
2086 }
2087 break;
2088 } else if (t == T_LVALUE) {
2089 if (!lvalue(*arg)) {
2090 c_error("bad argument %d for function %s (needs lvalue)",
2091 n, fname);
2092 }
2093 *arg = node_mon(N_LVALUE, (*arg)->mod, *arg);
2094 /* only kfuns can have lvalue parameters */
2095 func->r.number |= (long) KFCALL_LVAL << 24;
2096 } else if ((typechecked || (*arg)->mod == T_VOID) &&
2097 c_tmatch((*arg)->mod, t) == T_NIL &&
2098 (!c_nil(*arg) || !T_POINTER(t))) {
2099 c_error("bad argument %d for function %s (needs %s)", n, fname,
2100 i_typename(tnbuf, t));
2101 }
2102
2103 if (n == nargs && ellipsis) {
2104 nargs++;
2105 } else {
2106 argp += ((*argp & T_TYPE) == T_CLASS) ? 4 : 1;
2107 }
2108 }
2109 if (args != (node *) NULL && PROTO_FTYPE(proto) != T_IMPLICIT) {
2110 if (args->type == N_SPREAD) {
2111 t = args->l.left->mod;
2112 if (t != T_MIXED && (t & T_REF) == 0) {
2113 c_error("ellipsis requires array");
2114 }
2115 } else {
2116 c_error("too many arguments for function %s", fname);
2117 }
2118 }
2119
2120 return func;
2121 }
2122
2123 /*
2124 * NAME: compile->funcall()
2125 * DESCRIPTION: handle a function call
2126 */
c_funcall(node * func,node * args)2127 node *c_funcall(node *func, node *args)
2128 {
2129 return funcall(func, revert_list(args), FALSE);
2130 }
2131
2132 /*
2133 * NAME: compile->arrow()
2134 * DESCRIPTION: handle ->
2135 */
c_arrow(node * other,node * func,node * args)2136 node *c_arrow(node *other, node *func, node *args)
2137 {
2138 if (args == (node *) NULL) {
2139 args = func;
2140 } else {
2141 args = node_bin(N_PAIR, 0, func, revert_list(args));
2142 }
2143 return funcall(c_flookup(node_str(str_new("call_other", 10L)), FALSE),
2144 node_bin(N_PAIR, 0, other, args), FALSE);
2145 }
2146
2147 /*
2148 * NAME: compile->address()
2149 * DESCRIPTION: handle &func()
2150 */
c_address(node * func,node * args,int typechecked)2151 node *c_address(node *func, node *args, int typechecked)
2152 {
2153 # ifdef CLOSURES
2154 args = revert_list(args);
2155 funcall(c_flookup(func, typechecked), args, TRUE); /* check only */
2156
2157 if (args == (node *) NULL) {
2158 args = func;
2159 } else {
2160 args = node_bin(N_PAIR, 0, func, args);
2161 }
2162 func = funcall(c_flookup(node_str(str_new("new.function", 12L)), FALSE),
2163 args, FALSE);
2164 func->mod = T_CLASS;
2165 func->class = str_new(BIPREFIX "function", BIPREFIXLEN + 8);
2166 return func;
2167 # else
2168 UNREFERENCED_PARAMETER(func);
2169 UNREFERENCED_PARAMETER(args);
2170 UNREFERENCED_PARAMETER(typechecked);
2171 c_error("syntax error");
2172 return node_mon(N_FAKE, T_MIXED, (node *) NULL);
2173 # endif
2174 }
2175
2176 /*
2177 * NAME: compile->extend()
2178 * DESCRIPTION: handle &(*func)()
2179 */
c_extend(node * func,node * args,int typechecked)2180 node *c_extend(node *func, node *args, int typechecked)
2181 {
2182 # ifdef CLOSURES
2183 if (typechecked && func->mod != T_MIXED) {
2184 if (func->mod != T_OBJECT &&
2185 (func->mod != T_CLASS ||
2186 strcmp(func->class->text, BIPREFIX "function") != 0)) {
2187 c_error("bad argument 1 for function * (needs function)");
2188 }
2189 }
2190 if (args == (node *) NULL) {
2191 args = func;
2192 } else {
2193 args = node_bin(N_PAIR, 0, func, revert_list(args));
2194 }
2195 func = funcall(c_flookup(node_str(str_new("extend.function", 15L)), FALSE),
2196 args, FALSE);
2197 func->mod = T_CLASS;
2198 func->class = str_new(BIPREFIX "function", BIPREFIXLEN + 8);
2199 return func;
2200 # else
2201 UNREFERENCED_PARAMETER(func);
2202 UNREFERENCED_PARAMETER(args);
2203 UNREFERENCED_PARAMETER(typechecked);
2204 c_error("syntax error");
2205 return node_mon(N_FAKE, T_MIXED, (node *) NULL);
2206 # endif
2207 }
2208
2209 /*
2210 * NAME: compile->call()
2211 * DESCRIPTION: handle (*func)()
2212 */
c_call(node * func,node * args,int typechecked)2213 node *c_call(node *func, node *args, int typechecked)
2214 {
2215 # ifdef CLOSURES
2216 if (typechecked && func->mod != T_MIXED) {
2217 if (func->mod != T_OBJECT &&
2218 (func->mod != T_CLASS ||
2219 strcmp(func->class->text, BIPREFIX "function") != 0)) {
2220 c_error("bad argument 1 for function * (needs function)");
2221 }
2222 }
2223 if (args == (node *) NULL) {
2224 args = func;
2225 } else {
2226 args = node_bin(N_PAIR, 0, func, revert_list(args));
2227 }
2228 return funcall(c_flookup(node_str(str_new("call.function", 13L)), FALSE),
2229 args, FALSE);
2230 # else
2231 UNREFERENCED_PARAMETER(func);
2232 UNREFERENCED_PARAMETER(args);
2233 UNREFERENCED_PARAMETER(typechecked);
2234 c_error("syntax error");
2235 return node_mon(N_FAKE, T_MIXED, (node *) NULL);
2236 # endif
2237 }
2238
2239 /*
2240 * NAME: compile->instanceof()
2241 * DESCRIPTION: handle <-
2242 */
c_instanceof(node * n,node * prog)2243 node *c_instanceof(node *n, node *prog)
2244 {
2245 string *str;
2246
2247 if (n->mod != T_MIXED && n->mod != T_OBJECT && n->mod != T_CLASS) {
2248 c_error("bad argument 1 for function <- (needs object)");
2249 }
2250 str = c_objecttype(prog);
2251 str_del(prog->l.string);
2252 str_ref(prog->l.string = str);
2253 return node_bin(N_INSTANCEOF, T_INT, n, prog);
2254 }
2255
2256 /*
2257 * NAME: compile->checkcall()
2258 * DESCRIPTION: check return value of a system call
2259 */
c_checkcall(node * n,int typechecked)2260 node *c_checkcall(node *n, int typechecked)
2261 {
2262 if (n->type == N_FUNC && (n->r.number >> 24) == FCALL) {
2263 if (typechecked) {
2264 if (n->mod != T_MIXED && n->mod != T_VOID) {
2265 /*
2266 * make sure the return value is as it should be
2267 */
2268 n = node_mon(N_CAST, n->mod, n);
2269 n->class = n->l.left->class;
2270 }
2271 } else {
2272 /* could be anything */
2273 n->mod = T_MIXED;
2274 }
2275 } else if (n->mod == T_VOID && !typechecked) {
2276 /* no void expressions */
2277 n->mod = T_INT;
2278 }
2279
2280 return n;
2281 }
2282
2283 /*
2284 * NAME: compile->tst()
2285 * DESCRIPTION: handle a condition
2286 */
c_tst(node * n)2287 node *c_tst(node *n)
2288 {
2289 switch (n->type) {
2290 case N_INT:
2291 n->l.number = (n->l.number != 0);
2292 return n;
2293
2294 case N_FLOAT:
2295 return node_int((Int) !NFLT_ISZERO(n));
2296
2297 case N_STR:
2298 return node_int((Int) TRUE);
2299
2300 case N_NIL:
2301 return node_int((Int) FALSE);
2302
2303 case N_TST:
2304 case N_NOT:
2305 case N_LAND:
2306 case N_EQ:
2307 case N_EQ_INT:
2308 case N_NE:
2309 case N_NE_INT:
2310 case N_GT:
2311 case N_GT_INT:
2312 case N_GE:
2313 case N_GE_INT:
2314 case N_LT:
2315 case N_LT_INT:
2316 case N_LE:
2317 case N_LE_INT:
2318 return n;
2319
2320 case N_COMMA:
2321 n->mod = T_INT;
2322 n->r.right = c_tst(n->r.right);
2323 return n;
2324 }
2325
2326 return node_mon(N_TST, T_INT, n);
2327 }
2328
2329 /*
2330 * NAME: compile->not()
2331 * DESCRIPTION: handle a !condition
2332 */
c_not(node * n)2333 node *c_not(node *n)
2334 {
2335 switch (n->type) {
2336 case N_INT:
2337 n->l.number = (n->l.number == 0);
2338 return n;
2339
2340 case N_FLOAT:
2341 return node_int((Int) NFLT_ISZERO(n));
2342
2343 case N_STR:
2344 return node_int((Int) FALSE);
2345
2346 case N_NIL:
2347 return node_int((Int) TRUE);
2348
2349 case N_LAND:
2350 n->type = N_LOR;
2351 n->l.left = c_not(n->l.left);
2352 n->r.right = c_not(n->r.right);
2353 return n;
2354
2355 case N_LOR:
2356 n->type = N_LAND;
2357 n->l.left = c_not(n->l.left);
2358 n->r.right = c_not(n->r.right);
2359 return n;
2360
2361 case N_TST:
2362 n->type = N_NOT;
2363 return n;
2364
2365 case N_NOT:
2366 n->type = N_TST;
2367 return n;
2368
2369 case N_EQ:
2370 n->type = N_NE;
2371 return n;
2372
2373 case N_EQ_INT:
2374 n->type = N_NE_INT;
2375 return n;
2376
2377 case N_NE:
2378 n->type = N_EQ;
2379 return n;
2380
2381 case N_NE_INT:
2382 n->type = N_EQ_INT;
2383 return n;
2384
2385 case N_GT:
2386 n->type = N_LE;
2387 return n;
2388
2389 case N_GT_INT:
2390 n->type = N_LE_INT;
2391 return n;
2392
2393 case N_GE:
2394 n->type = N_LT;
2395 return n;
2396
2397 case N_GE_INT:
2398 n->type = N_LT_INT;
2399 return n;
2400
2401 case N_LT:
2402 n->type = N_GE;
2403 return n;
2404
2405 case N_LT_INT:
2406 n->type = N_GE_INT;
2407 return n;
2408
2409 case N_LE:
2410 n->type = N_GT;
2411 return n;
2412
2413 case N_LE_INT:
2414 n->type = N_GT_INT;
2415 return n;
2416
2417 case N_COMMA:
2418 n->mod = T_INT;
2419 n->r.right = c_not(n->r.right);
2420 return n;
2421 }
2422
2423 return node_mon(N_NOT, T_INT, n);
2424 }
2425
2426 /*
2427 * NAME: compile->lvalue()
2428 * DESCRIPTION: handle an lvalue
2429 */
c_lvalue(node * n,char * oper)2430 node *c_lvalue(node *n, char *oper)
2431 {
2432 if (!lvalue(n)) {
2433 c_error("bad lvalue for %s", oper);
2434 return node_mon(N_FAKE, T_MIXED, n);
2435 }
2436 return n;
2437 }
2438
2439 /*
2440 * NAME: compile->lval_aggr()
2441 * DESCRIPTION: check an aggregate of lvalues
2442 */
c_lval_aggr(node ** n)2443 static void c_lval_aggr(node **n)
2444 {
2445 node **m;
2446
2447 if (*n == (node *) NULL) {
2448 c_error("no lvalues in aggregate");
2449 } else {
2450 while (n != (node **) NULL) {
2451 if ((*n)->type == N_PAIR) {
2452 m = &(*n)->l.left;
2453 n = &(*n)->r.right;
2454 } else {
2455 m = n;
2456 n = (node **) NULL;
2457 }
2458 if (!lvalue(*m)) {
2459 c_error("bad lvalue in aggregate");
2460 *m = node_mon(N_FAKE, T_MIXED, *m);
2461 }
2462 if ((*m)->type == N_LOCAL && !BTST(thiscond->init, (*m)->r.number)) {
2463 BSET(thiscond->init, (*m)->r.number);
2464 --variables[(*m)->r.number].unset;
2465 }
2466 }
2467 }
2468 }
2469
2470 /*
2471 * NAME: compile->assign()
2472 * DESCRIPTION: handle an assignment
2473 */
c_assign(node * n)2474 node *c_assign(node *n)
2475 {
2476 if (n->type == N_AGGR) {
2477 c_lval_aggr(&n->l.left);
2478 } else {
2479 n = c_lvalue(n, "assignment");
2480 if (n->type == N_LOCAL && !BTST(thiscond->init, n->r.number)) {
2481 BSET(thiscond->init, n->r.number);
2482 --variables[n->r.number].unset;
2483 }
2484 }
2485 return n;
2486 }
2487
2488 /*
2489 * NAME: compile->tmatch()
2490 * DESCRIPTION: See if the two supplied types are compatible. If so, return the
2491 * combined type. If not, return T_NIL.
2492 */
c_tmatch(unsigned int type1,unsigned int type2)2493 unsigned short c_tmatch(unsigned int type1, unsigned int type2)
2494 {
2495 if (type1 == T_NIL || type2 == T_NIL) {
2496 /* nil doesn't match with anything else */
2497 return T_NIL;
2498 }
2499 if (type1 == type2) {
2500 return type1; /* identical types (including T_CLASS) */
2501 }
2502 if ((type1 & T_TYPE) == T_CLASS) {
2503 type1 = (type1 & T_REF) | T_OBJECT;
2504 }
2505 if ((type2 & T_TYPE) == T_CLASS) {
2506 type2 = (type2 & T_REF) | T_OBJECT;
2507 }
2508 if (type1 == type2) {
2509 return type1; /* identical types (excluding T_CLASS) */
2510 }
2511 if (type1 == T_VOID || type2 == T_VOID) {
2512 /* void doesn't match with anything else, not even with mixed */
2513 return T_NIL;
2514 }
2515 if ((type1 & T_TYPE) == T_MIXED && (type1 & T_REF) <= (type2 & T_REF)) {
2516 /* mixed <-> int, mixed * <-> int *, mixed * <-> int ** */
2517 if (type1 == T_MIXED && (type2 & T_REF) != 0) {
2518 type1 |= 1 << REFSHIFT; /* mixed <-> int * */
2519 }
2520 return type1;
2521 }
2522 if ((type2 & T_TYPE) == T_MIXED && (type2 & T_REF) <= (type1 & T_REF)) {
2523 /* int <-> mixed, int * <-> mixed *, int ** <-> mixed * */
2524 if (type2 == T_MIXED && (type1 & T_REF) != 0) {
2525 type2 |= 1 << REFSHIFT; /* int * <-> mixed */
2526 }
2527 return type2;
2528 }
2529 return T_NIL;
2530 }
2531
2532 /*
2533 * NAME: compile->error()
2534 * DESCRIPTION: Call the driver object with the supplied error message.
2535 */
c_error(char * format,...)2536 void c_error(char *format, ...)
2537 {
2538 va_list args;
2539 char *fname, buf[4 * STRINGSZ]; /* file name + 2 * string + overhead */
2540
2541 if (driver_object != (char *) NULL &&
2542 o_find(driver_object, OACC_READ) != (object *) NULL) {
2543 frame *f;
2544
2545 f = current->frame;
2546 fname = tk_filename();
2547 PUSH_STRVAL(f, str_new(fname, strlen(fname)));
2548 PUSH_INTVAL(f, tk_line());
2549 va_start(args, format);
2550 vsprintf(buf, format, args);
2551 PUSH_STRVAL(f, str_new(buf, (long) strlen(buf)));
2552
2553 call_driver_object(f, "compile_error", 3);
2554 i_del_value(f->sp++);
2555 } else {
2556 /* there is no driver object to call; show the error on stderr */
2557 sprintf(buf, "%s, %u: ", tk_filename(), tk_line());
2558 va_start(args, format);
2559 vsprintf(buf + strlen(buf), format, args);
2560 message("%s\012", buf); /* LF */
2561 }
2562
2563 nerrors++;
2564 }
2565